-20 *** Parameters derived by pdb statistical analysis by Shelly Rackovsky ***
-1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
-6 0 *********** SCCC-cys-cys
- 1 5.45931E-02 -1.10282E-01
- 2 4.82158E-01 -2.25706E-01
- 3 -3.67560E-02 -2.97931E-01
- 4 -2.49045E-01 9.67159E-02
- 5 1.34632E-01 -1.09511E-01
- 6 -1.68916E-01 -2.57077E-01
-6 0 *********** SCCC-cys-met
- 1 6.40963E-03 -8.09148E-02
- 2 2.48432E-01 -1.35278E-01
- 3 -7.67158E-02 -2.09906E-01
- 4 -2.03279E-01 1.80072E-01
- 5 1.17018E-01 -7.28347E-02
- 6 -1.16434E-01 -2.55404E-01
-6 0 *********** SCCC-cys-phe
- 1 2.46957E-03 -6.90023E-02
- 2 2.82778E-01 -1.40088E-01
- 3 -5.93369E-02 -2.06898E-01
- 4 -2.07033E-01 1.72839E-01
- 5 1.29682E-01 -7.80802E-02
- 6 -1.24887E-01 -2.47229E-01
-6 0 *********** SCCC-cys-ile
- 1 5.17851E-02 -1.17234E-01
- 2 1.68169E-01 -1.89794E-01
- 3 -9.59141E-02 -2.27578E-01
- 4 -1.93878E-01 1.62680E-01
- 5 7.40516E-02 -6.99551E-02
- 6 -1.00504E-01 -2.37842E-01
-6 0 *********** SCCC-cys-leu
- 1 6.44195E-03 -7.49974E-02
- 2 1.99861E-01 -1.57652E-01
- 3 -7.86098E-02 -1.91358E-01
- 4 -2.05404E-01 2.00564E-01
- 5 1.23188E-01 -6.63393E-02
- 6 -1.08968E-01 -2.43074E-01
-6 0 *********** SCCC-cys-val
- 1 3.93569E-02 -9.96239E-02
- 2 1.45329E-01 -1.74471E-01
- 3 -8.40500E-02 -2.07350E-01
- 4 -1.82728E-01 1.67441E-01
- 5 7.94596E-02 -7.25319E-02
- 6 -1.01735E-01 -2.34355E-01
-6 0 *********** SCCC-cys-trp
- 1 1.11121E-02 -7.80568E-02
- 2 3.01485E-01 -1.43698E-01
- 3 -5.84868E-02 -2.18165E-01
- 4 -2.03775E-01 1.55923E-01
- 5 1.21116E-01 -8.21209E-02
- 6 -1.27457E-01 -2.46761E-01
-6 0 *********** SCCC-cys-tyr
- 1 1.92918E-03 -6.91731E-02
- 2 2.81784E-01 -1.38897E-01
- 3 -5.98217E-02 -2.06231E-01
- 4 -2.06598E-01 1.73506E-01
- 5 1.29844E-01 -7.77232E-02
- 6 -1.24495E-01 -2.47822E-01
-6 0 *********** SCCC-cys-ala
- 1 -3.55771E-02 -5.72553E-02
- 2 2.00780E-01 -5.32466E-02
- 3 -8.65932E-02 -1.79483E-01
- 4 -1.97823E-01 2.14875E-01
- 5 1.24288E-01 -6.63089E-02
- 6 -1.14348E-01 -2.83161E-01
-6 0 *********** SCCC-cys-gly
- 1 -8.99719E-01 -3.06730E-01
- 2 5.19510E-01 2.67231E-01
- 3 -1.24890E-01 4.30351E-02
- 4 3.79635E-02 9.73085E-02
- 5 -9.52232E-02 2.26545E-02
- 6 -3.94545E-02 -1.71337E-01
-6 0 *********** SCCC-cys-thr
- 1 2.31120E-02 -6.02100E-02
- 2 2.46281E-01 -1.62147E-01
- 3 -5.70137E-02 -2.11843E-01
- 4 -2.20818E-01 1.23064E-01
- 5 9.00645E-02 -6.72328E-02
- 6 -1.20063E-01 -2.02380E-01
-6 0 *********** SCCC-cys-ser
- 1 1.98782E-01 -1.89672E-01
- 2 4.88464E-01 -4.97095E-01
- 3 -4.16198E-02 -3.79945E-01
- 4 -3.24676E-01 2.52388E-02
- 5 8.39623E-02 -1.36651E-01
- 6 -2.00125E-01 -1.86076E-01
-6 0 *********** SCCC-cys-gln
- 1 1.64904E-02 -8.99450E-02
- 2 3.60622E-01 -1.39490E-01
- 3 -5.96330E-02 -2.47606E-01
- 4 -2.11874E-01 1.40631E-01
- 5 1.18551E-01 -9.01857E-02
- 6 -1.37465E-01 -2.63109E-01
-6 0 *********** SCCC-cys-asn
- 1 -1.43719E-02 -9.83107E-02
- 2 6.38476E-01 -3.38175E-02
- 3 -1.01279E-02 -3.39412E-01
- 4 -2.25531E-01 1.02705E-01
- 5 1.60814E-01 -1.35305E-01
- 6 -1.88797E-01 -3.61858E-01
-6 0 *********** SCCC-cys-glu
- 1 4.31092E-02 -9.64928E-02
- 2 3.60906E-01 -1.94302E-01
- 3 -5.09037E-02 -2.55149E-01
- 4 -2.18269E-01 1.27379E-01
- 5 1.15615E-01 -9.38484E-02
- 6 -1.39056E-01 -2.47579E-01
-6 0 *********** SCCC-cys-asp
- 1 -2.30799E-02 -7.27225E-02
- 2 4.92423E-01 -9.86162E-02
- 3 -3.52881E-02 -2.59979E-01
- 4 -2.35300E-01 1.57689E-01
- 5 1.83470E-01 -9.35041E-02
- 6 -1.58576E-01 -2.98743E-01
-6 0 *********** SCCC-cys-his
- 1 6.84440E-02 -1.23694E-01
- 2 5.52244E-01 -2.04733E-01
- 3 -2.98255E-02 -3.41767E-01
- 4 -2.53115E-01 7.43386E-02
- 5 1.24230E-01 -1.23824E-01
- 6 -1.78848E-01 -2.80315E-01
-6 0 *********** SCCC-cys-arg
- 1 -2.44467E-03 -7.29119E-02
- 2 2.13443E-01 -1.14090E-01
- 3 -7.85595E-02 -1.92981E-01
- 4 -1.92943E-01 1.95561E-01
- 5 1.20217E-01 -6.61456E-02
- 6 -1.06840E-01 -2.58793E-01
-6 0 *********** SCCC-cys-lys
- 1 -1.27507E-02 -6.55858E-02
- 2 2.10507E-01 -8.05734E-02
- 3 -7.88342E-02 -1.92996E-01
- 4 -1.90763E-01 1.92004E-01
- 5 1.12415E-01 -6.95885E-02
- 6 -1.11073E-01 -2.64765E-01
-6 0 *********** SCCC-cys-pro
- 1 -3.54862E+01 8.90582E+00
- 2 2.80923E+01 -1.54585E+01
- 3 -1.81830E+01 1.86800E+01
- 4 8.71081E+00 -1.55236E+01
- 5 -2.42838E+00 8.99693E+00
- 6 -5.91881E-02 3.38803E+01
-6 0 *********** SCCC-met-cys
- 1 -3.01780E-01 5.36752E-01
- 2 4.12826E-01 3.13283E-01
- 3 1.63130E-01 -6.23383E-01
- 4 -3.56692E-01 4.90048E-01
- 5 4.81576E-01 -3.05150E-01
- 6 -3.19432E-01 -9.00480E-01
-6 0 *********** SCCC-met-met
- 1 -2.05458E-01 5.08672E-01
- 2 1.77517E-01 3.38951E-01
- 3 1.81966E-03 -5.39532E-01
- 4 -3.35948E-01 4.16529E-01
- 5 3.30316E-01 -2.26759E-01
- 6 -2.90481E-01 -7.78197E-01
-6 0 *********** SCCC-met-phe
- 1 -2.95017E-01 5.24049E-01
- 2 2.13559E-01 3.43243E-01
- 3 2.95122E-02 -5.69379E-01
- 4 -3.72998E-01 4.63311E-01
- 5 3.78469E-01 -2.58749E-01
- 6 -3.12538E-01 -8.34500E-01
-6 0 *********** SCCC-met-ile
- 1 -2.97778E-02 4.82312E-01
- 2 1.24540E-01 3.16384E-01
- 3 -1.63750E-02 -5.33428E-01
- 4 -2.90218E-01 3.65926E-01
- 5 2.85073E-01 -2.01339E-01
- 6 -2.67080E-01 -7.12581E-01
-6 0 *********** SCCC-met-leu
- 1 -2.45210E-01 5.28864E-01
- 2 1.27561E-01 3.21685E-01
- 3 -8.73769E-03 -5.69825E-01
- 4 -3.61352E-01 4.42058E-01
- 5 3.37631E-01 -2.37909E-01
- 6 -3.03101E-01 -7.91291E-01
-6 0 *********** SCCC-met-val
- 1 -8.17187E-02 4.93353E-01
- 2 9.36645E-02 3.25929E-01
- 3 -3.03968E-02 -5.33621E-01
- 4 -3.07898E-01 3.87350E-01
- 5 2.97244E-01 -2.07227E-01
- 6 -2.73594E-01 -7.28796E-01
-6 0 *********** SCCC-met-trp
- 1 -2.38615E-01 5.01395E-01
- 2 2.43429E-01 3.47681E-01
- 3 3.49735E-02 -5.49332E-01
- 4 -3.47839E-01 4.39748E-01
- 5 3.72628E-01 -2.47904E-01
- 6 -3.00035E-01 -8.08803E-01
-6 0 *********** SCCC-met-tyr
- 1 -2.92155E-01 5.21545E-01
- 2 2.14184E-01 3.44644E-01
- 3 2.76088E-02 -5.67233E-01
- 4 -3.72167E-01 4.61644E-01
- 5 3.77353E-01 -2.57476E-01
- 6 -3.12068E-01 -8.28761E-01
-6 0 *********** SCCC-met-ala
- 1 -2.80922E-01 4.82109E-01
- 2 1.35929E-01 3.78662E-01
- 3 -5.17388E-02 -5.04868E-01
- 4 -3.55075E-01 4.16220E-01
- 5 3.16298E-01 -2.17961E-01
- 6 -2.90815E-01 -7.62101E-01
-6 0 *********** SCCC-met-gly
- 1 -2.76509E-01 -9.21319E-01
- 2 5.06576E-01 2.65583E-01
- 3 3.06408E-02 -2.33690E-01
- 4 -1.36523E-02 1.21184E-01
- 5 6.50258E-02 -6.27890E-02
- 6 -3.87783E-02 -4.94003E-01
-6 0 *********** SCCC-met-thr
- 1 -3.26799E-01 5.28057E-01
- 2 1.64509E-01 3.25958E-01
- 3 5.00554E-02 -6.05141E-01
- 4 -3.81937E-01 4.72134E-01
- 5 3.75722E-01 -2.85411E-01
- 6 -3.14617E-01 -8.86460E-01
-6 0 *********** SCCC-met-ser
- 1 -2.67091E-01 5.64875E-01
- 2 4.50976E-01 2.03132E-01
- 3 2.84953E-01 -8.24005E-01
- 4 -4.14014E-01 5.83641E-01
- 5 5.56754E-01 -4.19675E-01
- 6 -3.52117E-01 -1.12998E+00
-6 0 *********** SCCC-met-gln
- 1 -2.05798E-01 5.05993E-01
- 2 2.89515E-01 3.45515E-01
- 3 6.17780E-02 -5.37561E-01
- 4 -3.17029E-01 4.20197E-01
- 5 3.72094E-01 -2.39211E-01
- 6 -2.86645E-01 -7.89640E-01
-6 0 *********** SCCC-met-asn
- 1 -4.62900E-01 5.09093E-01
- 2 5.68065E-01 4.23279E-01
- 3 1.82972E-01 -5.40787E-01
- 4 -3.46702E-01 5.07400E-01
- 5 5.59241E-01 -2.91757E-01
- 6 -3.22591E-01 -9.07169E-01
-6 0 *********** SCCC-met-glu
- 1 -2.08419E-01 5.30320E-01
- 2 2.87787E-01 3.15021E-01
- 3 9.06310E-02 -5.74778E-01
- 4 -3.28203E-01 4.41985E-01
- 5 3.92925E-01 -2.58649E-01
- 6 -2.94719E-01 -8.24200E-01
-6 0 *********** SCCC-met-asp
- 1 -5.59083E-01 5.17660E-01
- 2 4.44708E-01 4.08082E-01
- 3 1.30859E-01 -6.69641E-01
- 4 -4.58187E-01 5.82180E-01
- 5 5.62139E-01 -3.50621E-01
- 6 -3.84406E-01 -1.07305E+00
-6 0 *********** SCCC-met-his
- 1 -2.64054E-01 5.70729E-01
- 2 4.48676E-01 2.99134E-01
- 3 2.10458E-01 -5.78350E-01
- 4 -3.05617E-01 4.65948E-01
- 5 4.70184E-01 -2.86594E-01
- 6 -2.85875E-01 -8.38436E-01
-6 0 *********** SCCC-met-arg
- 1 -2.14506E-01 5.08442E-01
- 2 1.44051E-01 3.49230E-01
- 3 -1.81400E-02 -5.28486E-01
- 4 -3.38072E-01 4.17722E-01
- 5 3.21811E-01 -2.19762E-01
- 6 -2.88684E-01 -7.61195E-01
-6 0 *********** SCCC-met-lys
- 1 -2.26564E-01 5.06338E-01
- 2 1.32927E-01 3.67585E-01
- 3 -2.97057E-02 -5.08657E-01
- 4 -3.36240E-01 4.11839E-01
- 5 3.09527E-01 -2.13695E-01
- 6 -2.84749E-01 -7.50768E-01
-6 0 *********** SCCC-met-pro
- 1 -3.06216E+01 6.99962E+00
- 2 2.52794E+01 -1.31802E+01
- 3 -1.58023E+01 1.61761E+01
- 4 7.90152E+00 -1.39296E+01
- 5 -1.72751E+00 8.17312E+00
- 6 -1.90027E-01 2.87699E+01
-6 0 *********** SCCC-phe-cys
- 1 5.62736E-01 1.04786E+00
- 2 1.20811E-01 3.63352E-01
- 3 -3.34295E-02 -2.50754E-01
- 4 -2.69925E-01 2.50906E-01
- 5 1.41579E-01 -1.46389E-01
- 6 -1.77888E-01 -3.57024E-01
-6 0 *********** SCCC-phe-met
- 1 4.26193E-01 8.81392E-01
- 2 -7.23208E-03 5.11026E-01
- 3 -2.08569E-01 -2.20018E-01
- 4 -3.38093E-01 2.68202E-01
- 5 1.43968E-01 -1.53454E-01
- 6 -1.92996E-01 -4.43327E-01
-6 0 *********** SCCC-phe-phe
- 1 3.88862E-01 9.60538E-01
- 2 -4.23310E-02 4.67080E-01
- 3 -1.75250E-01 -2.36248E-01
- 4 -3.30159E-01 2.76872E-01
- 5 1.37983E-01 -1.50849E-01
- 6 -1.93462E-01 -4.33610E-01
-6 0 *********** SCCC-phe-ile
- 1 5.72607E-01 7.68745E-01
- 2 4.88185E-02 5.80985E-01
- 3 -2.31055E-01 -2.24889E-01
- 4 -3.48304E-01 2.82660E-01
- 5 1.50752E-01 -1.62104E-01
- 6 -2.02885E-01 -5.00246E-01
-6 0 *********** SCCC-phe-leu
- 1 3.91578E-01 9.45717E-01
- 2 -1.15507E-01 5.22986E-01
- 3 -2.51639E-01 -2.61998E-01
- 4 -3.46071E-01 2.61080E-01
- 5 1.65105E-01 -1.69832E-01
- 6 -1.88196E-01 -4.73010E-01
-6 0 *********** SCCC-phe-val
- 1 5.03556E-01 7.96803E-01
- 2 -1.66325E-02 5.87650E-01
- 3 -2.49792E-01 -2.37551E-01
- 4 -3.53604E-01 2.82476E-01
- 5 1.63603E-01 -1.72472E-01
- 6 -2.01254E-01 -5.21849E-01
-6 0 *********** SCCC-phe-trp
- 1 4.28126E-01 8.77309E-01
- 2 4.87514E-02 4.53685E-01
- 3 -1.37288E-01 -2.13143E-01
- 4 -3.20095E-01 2.88101E-01
- 5 1.32245E-01 -1.40251E-01
- 6 -1.98661E-01 -4.22537E-01
-6 0 *********** SCCC-phe-tyr
- 1 3.88218E-01 9.51717E-01
- 2 -3.58923E-02 4.66211E-01
- 3 -1.72971E-01 -2.32225E-01
- 4 -3.30818E-01 2.79730E-01
- 5 1.36602E-01 -1.49473E-01
- 6 -1.94379E-01 -4.24751E-01
-6 0 *********** SCCC-phe-ala
- 1 2.55458E-01 8.15015E-01
- 2 -4.51587E-02 4.79954E-01
- 3 -2.08805E-01 -2.03016E-01
- 4 -3.33866E-01 2.81987E-01
- 5 1.40177E-01 -1.41592E-01
- 6 -1.93078E-01 -4.39787E-01
-6 0 *********** SCCC-phe-gly
- 1 -3.86494E-01 -1.48424E+00
- 2 3.24905E-01 -3.87422E-02
- 3 -1.29073E-01 -3.58128E-01
- 4 -1.08789E-01 1.40002E-01
- 5 8.16376E-02 -1.18575E-01
- 6 -1.10887E-01 -6.06428E-01
-6 0 *********** SCCC-phe-thr
- 1 3.19424E-01 9.80432E-01
- 2 -1.64358E-01 4.20044E-01
- 3 -1.90102E-01 -3.55953E-01
- 4 -2.84628E-01 2.16596E-01
- 5 1.59156E-01 -1.61977E-01
- 6 -1.76591E-01 -4.39485E-01
-6 0 *********** SCCC-phe-ser
- 1 8.90027E-01 1.22895E+00
- 2 9.14301E-02 3.29414E-01
- 3 5.02864E-02 -4.50696E-01
- 4 -1.65287E-01 2.31000E-01
- 5 2.17641E-01 -1.62464E-01
- 6 -1.74819E-01 -4.17520E-01
-6 0 *********** SCCC-phe-gln
- 1 4.96136E-01 8.94718E-01
- 2 1.14712E-01 4.62575E-01
- 3 -1.22486E-01 -1.97607E-01
- 4 -3.06351E-01 2.64405E-01
- 5 1.32663E-01 -1.38198E-01
- 6 -1.90748E-01 -3.96121E-01
-6 0 *********** SCCC-phe-asn
- 1 3.71138E-01 1.03914E+00
- 2 2.42518E-01 2.61000E-01
- 3 7.98518E-02 -1.58115E-01
- 4 -2.14977E-01 2.38309E-01
- 5 1.37618E-01 -1.15462E-01
- 6 -1.46034E-01 -2.43843E-01
-6 0 *********** SCCC-phe-glu
- 1 5.52266E-01 9.69128E-01
- 2 7.38434E-02 4.69791E-01
- 3 -1.26632E-01 -2.34747E-01
- 4 -3.04414E-01 2.59399E-01
- 5 1.44178E-01 -1.50510E-01
- 6 -1.89383E-01 -4.13418E-01
-6 0 *********** SCCC-phe-asp
- 1 3.22985E-01 1.15989E+00
- 2 -1.46185E-02 2.93775E-01
- 3 -4.01305E-02 -2.40166E-01
- 4 -2.90918E-01 2.58059E-01
- 5 1.11870E-01 -1.48253E-01
- 6 -1.63544E-01 -3.18868E-01
-6 0 *********** SCCC-phe-his
- 1 6.55475E-01 1.14317E+00
- 2 1.69105E-01 4.08599E-01
- 3 -9.38497E-03 -2.41840E-01
- 4 -2.15868E-01 2.20551E-01
- 5 1.66436E-01 -1.33832E-01
- 6 -1.56176E-01 -3.18403E-01
-6 0 *********** SCCC-phe-arg
- 1 3.90077E-01 8.75619E-01
- 2 -3.88447E-02 5.28799E-01
- 3 -2.24470E-01 -2.18291E-01
- 4 -3.38578E-01 2.73160E-01
- 5 1.50688E-01 -1.54281E-01
- 6 -1.91212E-01 -4.58614E-01
-6 0 *********** SCCC-phe-lys
- 1 3.59006E-01 8.73322E-01
- 2 -4.47749E-02 5.43684E-01
- 3 -2.34643E-01 -2.07829E-01
- 4 -3.41267E-01 2.66591E-01
- 5 1.43842E-01 -1.53896E-01
- 6 -1.90224E-01 -4.42073E-01
-6 0 *********** SCCC-phe-pro
- 1 -1.42086E+01 1.77362E+00
- 2 1.24527E+01 -6.76589E+00
- 3 -7.32196E+00 7.04425E+00
- 4 3.47537E+00 -6.70933E+00
- 5 -7.01907E-01 3.63147E+00
- 6 -2.79033E-01 1.33553E+01
-6 0 *********** SCCC-ile-cys
- 1 -9.06482E-02 3.06526E-01
- 2 4.73714E-01 -4.32743E-01
- 3 -3.89692E-01 -1.97297E-01
- 4 3.68788E-01 1.85061E-02
- 5 -5.30473E-01 -5.35170E-02
- 6 1.98534E-01 3.15889E-02
-6 0 *********** SCCC-ile-met
- 1 -4.70288E-02 2.77782E-01
- 2 2.56609E-01 -2.20614E-01
- 3 -3.71185E-01 -1.03354E-01
- 4 2.98581E-01 4.33961E-02
- 5 -3.85196E-01 -1.53739E-03
- 6 1.45764E-01 2.41653E-02
-6 0 *********** SCCC-ile-phe
- 1 -6.95791E-02 3.09726E-01
- 2 2.70410E-01 -2.49908E-01
- 3 -3.55388E-01 -1.11042E-01
- 4 3.06779E-01 5.00167E-02
- 5 -3.99266E-01 -9.78447E-03
- 6 1.53915E-01 2.60592E-02
-6 0 *********** SCCC-ile-ile
- 1 1.67046E-02 2.01920E-01
- 2 2.21628E-01 -2.00331E-01
- 3 -4.25387E-01 -1.19355E-01
- 4 2.95960E-01 2.49516E-02
- 5 -3.98268E-01 7.03663E-03
- 6 1.41153E-01 2.75675E-02
-6 0 *********** SCCC-ile-leu
- 1 -4.69683E-02 2.95297E-01
- 2 1.89376E-01 -2.05614E-01
- 3 -3.69213E-01 -1.00382E-01
- 4 2.96749E-01 5.43458E-02
- 5 -3.74389E-01 4.98680E-03
- 6 1.40244E-01 3.35776E-02
-6 0 *********** SCCC-ile-val
- 1 6.77440E-04 2.25469E-01
- 2 1.91904E-01 -1.74263E-01
- 3 -4.11560E-01 -1.05900E-01
- 4 2.95083E-01 2.91144E-02
- 5 -3.89410E-01 5.43783E-03
- 6 1.38324E-01 2.76631E-02
-6 0 *********** SCCC-ile-trp
- 1 -6.34676E-02 2.86027E-01
- 2 3.12959E-01 -2.62544E-01
- 3 -3.69513E-01 -1.18723E-01
- 4 3.16352E-01 3.78559E-02
- 5 -4.16528E-01 -1.43969E-02
- 6 1.59867E-01 3.23977E-02
-6 0 *********** SCCC-ile-tyr
- 1 -6.97422E-02 3.08402E-01
- 2 2.71268E-01 -2.48563E-01
- 3 -3.55867E-01 -1.10027E-01
- 4 3.07072E-01 4.98213E-02
- 5 -3.98853E-01 -9.64549E-03
- 6 1.54006E-01 1.82873E-02
-6 0 *********** SCCC-ile-ala
- 1 -7.30355E-02 2.97628E-01
- 2 2.03818E-01 -1.40547E-01
- 3 -3.33907E-01 -5.53480E-02
- 4 2.59665E-01 5.62984E-02
- 5 -3.32511E-01 3.85827E-03
- 6 1.22431E-01 3.24782E-02
-6 0 *********** SCCC-ile-gly
- 1 -7.77069E-01 -4.78662E-01
- 2 5.65410E-01 3.13515E-02
- 3 -6.66011E-02 -2.14325E-01
- 4 -5.93211E-03 5.93862E-02
- 5 4.84755E-02 -6.40522E-02
- 6 -5.03652E-02 -2.93044E-01
-6 0 *********** SCCC-ile-thr
- 1 -4.62156E-02 3.09758E-01
- 2 2.10482E-01 -2.30955E-01
- 3 -3.43062E-01 -1.25088E-01
- 4 2.57377E-01 5.71369E-02
- 5 -3.92084E-01 -5.07925E-03
- 6 1.32803E-01 2.78824E-02
-6 0 *********** SCCC-ile-ser
- 1 -9.35681E-02 2.47429E-01
- 2 5.61682E-01 -6.24156E-01
- 3 -5.73157E-01 -3.60078E-01
- 4 4.84501E-01 -3.23809E-02
- 5 -7.93399E-01 -8.93653E-02
- 6 2.45691E-01 1.19833E-02
-6 0 *********** SCCC-ile-gln
- 1 -6.15355E-02 2.77919E-01
- 2 3.77561E-01 -2.95386E-01
- 3 -3.74191E-01 -1.33565E-01
- 4 3.24465E-01 2.58384E-02
- 5 -4.33676E-01 -2.08755E-02
- 6 1.65280E-01 4.94663E-02
-6 0 *********** SCCC-ile-asn
- 1 -1.71793E-01 3.57789E-01
- 2 6.42507E-01 -4.15485E-01
- 3 -3.14277E-01 -1.44138E-01
- 4 3.65341E-01 7.27856E-03
- 5 -4.92921E-01 -7.13500E-02
- 6 2.00846E-01 5.69640E-02
-6 0 *********** SCCC-ile-glu
- 1 -5.53419E-02 2.80598E-01
- 2 3.71533E-01 -3.30905E-01
- 3 -3.92671E-01 -1.61189E-01
- 4 3.42084E-01 2.36931E-02
- 5 -4.66633E-01 -2.51863E-02
- 6 1.73998E-01 2.59762E-02
-6 0 *********** SCCC-ile-asp
- 1 -1.28191E-01 3.73836E-01
- 2 4.24434E-01 -3.79418E-01
- 3 -2.98778E-01 -1.32485E-01
- 4 3.11695E-01 5.45769E-02
- 5 -4.35127E-01 -4.66159E-02
- 6 1.77902E-01 4.77835E-02
-6 0 *********** SCCC-ile-his
- 1 -1.01933E-01 3.07532E-01
- 2 5.62819E-01 -4.55388E-01
- 3 -3.94388E-01 -2.13715E-01
- 4 3.87996E-01 -5.04240E-05
- 5 -5.58396E-01 -6.36935E-02
- 6 2.04482E-01 4.23809E-02
-6 0 *********** SCCC-ile-arg
- 1 -5.15008E-02 2.82264E-01
- 2 2.30327E-01 -1.84639E-01
- 3 -3.66201E-01 -8.80618E-02
- 4 2.94458E-01 4.57293E-02
- 5 -3.69877E-01 2.03339E-03
- 6 1.39599E-01 4.09605E-02
-6 0 *********** SCCC-ile-lys
- 1 -5.65761E-02 2.86599E-01
- 2 2.27566E-01 -1.58025E-01
- 3 -3.53513E-01 -7.51403E-02
- 4 2.77978E-01 4.72638E-02
- 5 -3.55384E-01 2.91141E-03
- 6 1.31825E-01 3.52149E-02
-6 0 *********** SCCC-ile-pro
- 1 -2.90830E+01 -5.25163E-01
- 2 1.73873E+01 6.84163E-02
- 3 2.13198E-01 1.12906E-01
- 4 -1.56796E+01 -1.79716E-01
- 5 2.77503E+01 1.06571E-01
- 6 -1.58066E+01 -5.23707E-02
-6 0 *********** SCCC-leu-cys
- 1 1.82689E-01 6.61723E-01
- 2 1.45335E-01 -3.83929E-01
- 3 -1.63053E-01 -2.08538E-01
- 4 8.34856E-02 2.60962E-02
- 5 -2.53232E-01 -5.58680E-02
- 6 5.45046E-02 6.94273E-02
-6 0 *********** SCCC-leu-met
- 1 1.49410E-01 5.75606E-01
- 2 6.91954E-02 -1.21745E-01
- 3 -3.04426E-01 -9.01305E-02
- 4 1.38974E-01 4.71152E-02
- 5 -2.34761E-01 -3.05869E-03
- 6 7.30624E-02 5.28832E-02
-6 0 *********** SCCC-leu-phe
- 1 1.16985E-01 6.31897E-01
- 2 5.30040E-02 -1.73279E-01
- 3 -2.57166E-01 -1.00380E-01
- 4 1.27192E-01 6.73332E-02
- 5 -2.41746E-01 -1.42924E-02
- 6 7.40644E-02 4.74807E-02
-6 0 *********** SCCC-leu-ile
- 1 2.51741E-01 4.87632E-01
- 2 5.93123E-02 -7.34831E-02
- 3 -3.75411E-01 -1.10380E-01
- 4 1.65097E-01 2.25079E-02
- 5 -2.57908E-01 6.03095E-03
- 6 8.19231E-02 3.48478E-02
-6 0 *********** SCCC-leu-leu
- 1 1.33496E-01 6.13415E-01
- 2 -6.58440E-03 -1.12905E-01
- 3 -3.13647E-01 -8.65109E-02
- 4 1.46109E-01 6.86339E-02
- 5 -2.42828E-01 2.19112E-03
- 6 7.61703E-02 5.58780E-02
-6 0 *********** SCCC-leu-val
- 1 2.17695E-01 5.17836E-01
- 2 2.72232E-02 -5.34491E-02
- 3 -3.66078E-01 -9.13391E-02
- 4 1.66183E-01 3.52496E-02
- 5 -2.64789E-01 2.97273E-03
- 6 8.32752E-02 3.05015E-02
-6 0 *********** SCCC-leu-trp
- 1 1.48129E-01 5.88059E-01
- 2 1.01082E-01 -1.78913E-01
- 3 -2.58325E-01 -1.05970E-01
- 4 1.25811E-01 4.84123E-02
- 5 -2.41842E-01 -1.91537E-02
- 6 7.31110E-02 4.73471E-02
-6 0 *********** SCCC-leu-tyr
- 1 1.17435E-01 6.28308E-01
- 2 5.56951E-02 -1.71437E-01
- 3 -2.58090E-01 -9.82451E-02
- 4 1.27061E-01 6.68122E-02
- 5 -2.41126E-01 -1.43671E-02
- 6 7.42543E-02 5.85918E-02
-6 0 *********** SCCC-leu-ala
- 1 6.25619E-02 5.72521E-01
- 2 6.39324E-02 -5.25259E-02
- 3 -3.12947E-01 -2.70696E-02
- 4 1.29353E-01 6.41332E-02
- 5 -2.29307E-01 -2.65277E-04
- 6 6.92854E-02 5.45214E-02
-6 0 *********** SCCC-leu-gly
- 1 -5.07454E-01 -7.12336E-01
- 2 6.21750E-01 -1.43399E-01
- 3 -5.20535E-02 -2.12833E-01
- 4 7.12664E-02 1.36647E-02
- 5 5.97499E-02 -6.67030E-02
- 6 -1.78196E-02 -2.40561E-01
-6 0 *********** SCCC-leu-thr
- 1 9.60331E-02 6.50755E-01
- 2 2.56458E-03 -1.64702E-01
- 3 -2.70905E-01 -1.49122E-01
- 4 1.32041E-01 9.33707E-02
- 5 -2.95369E-01 -1.48786E-02
- 6 8.31390E-02 7.03886E-03
-6 0 *********** SCCC-leu-ser
- 1 3.32853E-01 7.31043E-01
- 2 -1.29113E-02 -6.28811E-01
- 3 -1.11877E-01 -3.96711E-01
- 4 3.39903E-02 4.16725E-02
- 5 -3.85526E-01 -1.25008E-01
- 6 4.86841E-02 -3.76682E-03
-6 0 *********** SCCC-leu-gln
- 1 1.71457E-01 5.75117E-01
- 2 1.56209E-01 -2.06167E-01
- 3 -2.50126E-01 -1.29722E-01
- 4 1.21688E-01 2.16208E-02
- 5 -2.30293E-01 -2.07333E-02
- 6 6.35899E-02 6.98307E-02
-6 0 *********** SCCC-leu-asn
- 1 3.58694E-02 6.95532E-01
- 2 3.31508E-01 -4.07236E-01
- 3 -6.80974E-02 -1.57478E-01
- 4 5.93611E-02 4.16173E-03
- 5 -1.98546E-01 -7.19475E-02
- 6 3.75504E-02 1.10659E-01
-6 0 *********** SCCC-leu-glu
- 1 1.97783E-01 6.05729E-01
- 2 1.11591E-01 -2.46386E-01
- 3 -2.40107E-01 -1.64984E-01
- 4 1.24724E-01 2.80708E-02
- 5 -2.47436E-01 -2.46564E-02
- 6 6.46178E-02 5.35425E-02
-6 0 *********** SCCC-leu-asp
- 1 2.18484E-02 7.58889E-01
- 2 1.34036E-01 -3.72637E-01
- 3 -1.11032E-01 -1.35427E-01
- 4 6.24580E-02 8.13465E-02
- 5 -2.23117E-01 -6.05562E-02
- 6 6.38299E-02 7.99218E-02
-6 0 *********** SCCC-leu-his
- 1 1.94226E-01 6.65303E-01
- 2 2.07196E-01 -3.99651E-01
- 3 -1.48655E-01 -2.47027E-01
- 4 9.76349E-02 -6.06183E-03
- 5 -2.43279E-01 -4.99361E-02
- 6 3.71873E-02 8.17822E-02
-6 0 *********** SCCC-leu-arg
- 1 1.31589E-01 5.77691E-01
- 2 5.42293E-02 -8.45056E-02
- 3 -3.13232E-01 -7.04597E-02
- 4 1.47457E-01 5.25674E-02
- 5 -2.35376E-01 -2.01349E-03
- 6 7.53322E-02 5.25001E-02
-6 0 *********** SCCC-leu-lys
- 1 1.08323E-01 5.75368E-01
- 2 6.66998E-02 -5.76889E-02
- 3 -3.16971E-01 -5.89524E-02
- 4 1.45904E-01 5.32025E-02
- 5 -2.36424E-01 1.66523E-03
- 6 7.31761E-02 5.24056E-02
-6 0 *********** SCCC-leu-pro
- 1 -2.95936E+01 -8.13497E+00
- 2 2.54209E+01 1.34203E+01
- 3 -1.50359E+01 -1.49607E+01
- 4 7.74638E+00 1.35518E+01
- 5 -1.72657E+00 -7.45364E+00
- 6 -2.19544E-01 -2.85411E+01
-6 0 *********** SCCC-val-cys
- 1 8.00832E-01 1.11313E+00
- 2 2.17101E-01 3.95667E-01
- 3 -1.05806E-01 -1.53294E-01
- 4 -3.87639E-01 3.12485E-01
- 5 2.41862E-02 -9.52883E-02
- 6 -2.33532E-01 -3.11032E-01
-6 0 *********** SCCC-val-met
- 1 6.82733E-01 1.01959E+00
- 2 2.21384E-02 5.68410E-01
- 3 -2.91292E-01 -2.10435E-03
- 4 -3.93133E-01 3.31397E-01
- 5 -1.52095E-02 -4.32610E-02
- 6 -2.04752E-01 -2.75562E-01
-6 0 *********** SCCC-val-phe
- 1 6.35410E-01 1.09440E+00
- 2 -1.41673E-03 5.24116E-01
- 3 -2.49341E-01 -2.12621E-02
- 4 -3.98756E-01 3.46745E-01
- 5 -1.73237E-02 -4.91361E-02
- 6 -2.14567E-01 -2.73952E-01
-6 0 *********** SCCC-val-ile
- 1 8.88508E-01 9.30617E-01
- 2 6.05838E-02 6.18320E-01
- 3 -3.17116E-01 4.67575E-02
- 4 -3.83531E-01 3.31939E-01
- 5 -6.79469E-02 -1.93742E-02
- 6 -1.98734E-01 -2.68255E-01
-6 0 *********** SCCC-val-leu
- 1 6.69095E-01 1.11535E+00
- 2 -1.09749E-01 5.86002E-01
- 3 -3.49277E-01 -1.11956E-02
- 4 -4.02386E-01 3.18310E-01
- 5 -7.25214E-03 -5.34410E-02
- 6 -1.89001E-01 -2.69876E-01
-6 0 *********** SCCC-val-val
- 1 8.21720E-01 9.74747E-01
- 2 -1.34219E-02 6.27391E-01
- 3 -3.33221E-01 5.18120E-02
- 4 -3.83662E-01 3.18949E-01
- 5 -6.53774E-02 -3.16696E-02
- 6 -1.96307E-01 -2.63360E-01
-6 0 *********** SCCC-val-trp
- 1 6.51842E-01 9.79381E-01
- 2 9.07931E-02 4.74654E-01
- 3 -1.99423E-01 -3.29161E-02
- 4 -3.69585E-01 3.35195E-01
- 5 -5.54390E-03 -4.75149E-02
- 6 -2.12448E-01 -2.79979E-01
-6 0 *********** SCCC-val-tyr
- 1 6.33199E-01 1.08315E+00
- 2 5.78338E-03 5.21194E-01
- 3 -2.45650E-01 -1.75165E-02
- 4 -3.98129E-01 3.49843E-01
- 5 -1.81537E-02 -4.72674E-02
- 6 -2.15142E-01 -2.82477E-01
-6 0 *********** SCCC-val-ala
- 1 4.60554E-01 9.27295E-01
- 2 -2.12472E-02 5.12717E-01
- 3 -2.72683E-01 -9.24481E-03
- 4 -3.67425E-01 3.37906E-01
- 5 5.93982E-03 -3.92029E-02
- 6 -1.97185E-01 -2.83221E-01
-6 0 *********** SCCC-val-gly
- 1 -4.86806E-01 -1.53153E+00
- 2 3.94205E-01 -1.70152E-01
- 3 -2.27152E-01 -2.17713E-01
- 4 -7.88180E-03 1.17063E-01
- 5 2.11058E-02 -3.41489E-02
- 6 -4.65275E-02 -4.17365E-01
-6 0 *********** SCCC-val-thr
- 1 5.29657E-01 1.12563E+00
- 2 -2.05541E-01 4.11231E-01
- 3 -2.92544E-01 -2.14031E-01
- 4 -3.28553E-01 1.64674E-01
- 5 4.90184E-02 -1.02758E-01
- 6 -1.39771E-01 -2.51991E-01
-6 0 *********** SCCC-val-ser
- 1 1.33215E+00 1.30633E+00
- 2 2.34878E-01 2.72101E-01
- 3 -1.11535E-02 -3.56899E-01
- 4 -2.80237E-01 2.33424E-01
- 5 6.08041E-02 -1.27302E-01
- 6 -2.03272E-01 -3.21272E-01
-6 0 *********** SCCC-val-gln
- 1 7.31603E-01 9.92853E-01
- 2 1.80112E-01 5.13236E-01
- 3 -1.92179E-01 -4.35785E-02
- 4 -3.78467E-01 3.25224E-01
- 5 2.32679E-03 -5.66945E-02
- 6 -2.22093E-01 -2.99824E-01
-6 0 *********** SCCC-val-asn
- 1 4.93846E-01 1.01398E+00
- 2 3.98892E-01 2.91547E-01
- 3 5.82251E-02 -2.30716E-01
- 4 -3.64739E-01 2.98368E-01
- 5 1.10884E-01 -1.48590E-01
- 6 -2.46003E-01 -3.72811E-01
-6 0 *********** SCCC-val-glu
- 1 8.24553E-01 1.09173E+00
- 2 1.35240E-01 5.27544E-01
- 3 -2.06300E-01 -5.27107E-02
- 4 -3.87510E-01 3.21258E-01
- 5 -1.06841E-02 -6.15764E-02
- 6 -2.21645E-01 -2.89693E-01
-6 0 *********** SCCC-val-asp
- 1 5.09520E-01 1.24510E+00
- 2 1.02666E-01 4.07419E-01
- 3 -9.87052E-02 -1.12490E-01
- 4 -4.47943E-01 4.06738E-01
- 5 2.26632E-02 -9.71246E-02
- 6 -2.39450E-01 -3.45170E-01
-6 0 *********** SCCC-val-his
- 1 9.63831E-01 1.23306E+00
- 2 3.13947E-01 5.06482E-01
- 3 -8.28701E-02 -1.66336E-01
- 4 -3.70574E-01 3.04856E-01
- 5 3.83417E-02 -9.80156E-02
- 6 -2.40786E-01 -3.41551E-01
-6 0 *********** SCCC-val-arg
- 1 6.46155E-01 1.02135E+00
- 2 -1.80402E-02 5.83940E-01
- 3 -3.03968E-01 1.06208E-02
- 4 -3.81791E-01 3.33161E-01
- 5 -8.70441E-03 -3.89505E-02
- 6 -1.94363E-01 -2.73490E-01
-6 0 *********** SCCC-val-lys
- 1 6.17618E-01 1.02630E+00
- 2 -1.84483E-02 6.14428E-01
- 3 -3.14126E-01 2.08371E-02
- 4 -3.91659E-01 3.27774E-01
- 5 -2.39671E-02 -4.27168E-02
- 6 -2.00647E-01 -2.78894E-01
-6 0 *********** SCCC-val-pro
- 1 -4.76439E+01 -2.71010E+00
- 2 3.53401E+01 -7.48312E-01
- 3 -1.67057E+01 4.63748E-02
- 4 -4.31729E-01 -7.08512E-01
- 5 1.23807E+01 9.40533E-02
- 6 -8.50442E+00 2.38787E-01
-6 0 *********** SCCC-trp-cys
- 1 3.37649E-01 9.09889E-01
- 2 2.86174E-01 7.58962E-01
- 3 -2.02931E-02 -5.34232E-01
- 4 -4.46189E-01 5.70288E-01
- 5 4.19880E-01 -3.04817E-01
- 6 -3.56946E-01 -1.01318E+00
-6 0 *********** SCCC-trp-met
- 1 2.47398E-01 7.62366E-01
- 2 1.06479E-01 7.43559E-01
- 3 -1.91251E-01 -4.34464E-01
- 4 -4.56574E-01 4.57902E-01
- 5 3.33909E-01 -2.75793E-01
- 6 -3.09010E-01 -8.69081E-01
-6 0 *********** SCCC-trp-phe
- 1 1.78922E-01 8.24870E-01
- 2 8.47641E-02 7.50405E-01
- 3 -1.68434E-01 -5.01025E-01
- 4 -4.67714E-01 4.99484E-01
- 5 3.72017E-01 -2.95722E-01
- 6 -3.29404E-01 -9.49312E-01
-6 0 *********** SCCC-trp-ile
- 1 4.47921E-01 6.79002E-01
- 2 1.51899E-01 7.52962E-01
- 3 -2.06371E-01 -3.56420E-01
- 4 -4.36025E-01 4.26899E-01
- 5 2.72879E-01 -2.42961E-01
- 6 -2.91889E-01 -8.10199E-01
-6 0 *********** SCCC-trp-leu
- 1 2.03976E-01 8.20070E-01
- 2 2.80079E-03 7.65309E-01
- 3 -2.44485E-01 -4.94975E-01
- 4 -4.68023E-01 4.41083E-01
- 5 3.69494E-01 -3.05596E-01
- 6 -3.02606E-01 -9.26160E-01
-6 0 *********** SCCC-trp-val
- 1 3.67124E-01 6.99197E-01
- 2 8.36434E-02 7.57620E-01
- 3 -2.31891E-01 -3.88297E-01
- 4 -4.40733E-01 4.20966E-01
- 5 2.99445E-01 -2.61174E-01
- 6 -2.86252E-01 -8.42604E-01
-6 0 *********** SCCC-trp-trp
- 1 2.30271E-01 7.50229E-01
- 2 1.71560E-01 7.22312E-01
- 3 -1.22583E-01 -4.55072E-01
- 4 -4.50360E-01 5.11055E-01
- 5 3.47353E-01 -2.70500E-01
- 6 -3.31030E-01 -9.03172E-01
-6 0 *********** SCCC-trp-tyr
- 1 1.78834E-01 8.16387E-01
- 2 9.07623E-02 7.47537E-01
- 3 -1.65156E-01 -4.95962E-01
- 4 -4.67431E-01 5.02163E-01
- 5 3.68875E-01 -2.92992E-01
- 6 -3.30262E-01 -9.36530E-01
-6 0 *********** SCCC-trp-ala
- 1 6.86380E-02 6.92189E-01
- 2 5.63145E-02 6.91403E-01
- 3 -1.90592E-01 -4.34094E-01
- 4 -4.43969E-01 4.57393E-01
- 5 3.35512E-01 -2.66348E-01
- 6 -3.04003E-01 -8.68638E-01
-6 0 *********** SCCC-trp-gly
- 1 -3.45354E-01 -1.54306E+00
- 2 2.11460E-01 -5.44853E-02
- 3 -1.36962E-01 -3.27616E-01
- 4 -1.09838E-01 9.20244E-02
- 5 2.45033E-02 -1.15751E-01
- 6 -1.00027E-01 -5.58324E-01
-6 0 *********** SCCC-trp-thr
- 1 8.99073E-02 8.26441E-01
- 2 -2.52994E-02 7.09003E-01
- 3 -1.90315E-01 -6.33005E-01
- 4 -4.17490E-01 4.41903E-01
- 5 4.18769E-01 -3.18521E-01
- 6 -3.14079E-01 -9.67357E-01
-6 0 *********** SCCC-trp-ser
- 1 7.42704E-01 1.12034E+00
- 2 3.83798E-01 9.17963E-01
- 3 6.60610E-02 -7.08740E-01
- 4 -3.70109E-01 6.38153E-01
- 5 5.59051E-01 -3.31966E-01
- 6 -3.85606E-01 -1.18095E+00
-6 0 *********** SCCC-trp-gln
- 1 3.10196E-01 7.76165E-01
- 2 2.39625E-01 7.40437E-01
- 3 -1.01625E-01 -4.18185E-01
- 4 -4.43114E-01 5.02142E-01
- 5 3.38783E-01 -2.62519E-01
- 6 -3.27065E-01 -8.80261E-01
-6 0 *********** SCCC-trp-asn
- 1 1.22021E-01 8.86028E-01
- 2 3.80031E-01 6.55884E-01
- 3 9.93551E-02 -4.81570E-01
- 4 -3.95301E-01 5.80544E-01
- 5 4.56302E-01 -2.86007E-01
- 6 -3.32539E-01 -9.52488E-01
-6 0 *********** SCCC-trp-glu
- 1 3.67498E-01 8.51136E-01
- 2 2.12658E-01 7.78789E-01
- 3 -1.14620E-01 -4.57853E-01
- 4 -4.52338E-01 5.08623E-01
- 5 3.58685E-01 -2.81119E-01
- 6 -3.32412E-01 -9.23366E-01
-6 0 *********** SCCC-trp-asp
- 1 3.25471E-02 9.79745E-01
- 2 1.41385E-01 7.15914E-01
- 3 -4.34295E-02 -6.35287E-01
- 4 -4.81601E-01 5.85842E-01
- 5 4.66118E-01 -3.51560E-01
- 6 -3.64698E-01 -1.08730E+00
-6 0 *********** SCCC-trp-his
- 1 5.04062E-01 1.05289E+00
- 2 3.49783E-01 8.54838E-01
- 3 -4.76426E-03 -4.41925E-01
- 4 -4.22115E-01 5.66702E-01
- 5 4.02071E-01 -2.74061E-01
- 6 -3.44885E-01 -9.43163E-01
-6 0 *********** SCCC-trp-arg
- 1 2.14940E-01 7.57486E-01
- 2 7.02036E-02 7.47202E-01
- 3 -2.09561E-01 -4.30390E-01
- 4 -4.52958E-01 4.48647E-01
- 5 3.33891E-01 -2.75377E-01
- 6 -3.02099E-01 -8.70498E-01
-6 0 *********** SCCC-trp-lys
- 1 1.87248E-01 7.57461E-01
- 2 5.84439E-02 7.51977E-01
- 3 -2.19657E-01 -4.13751E-01
- 4 -4.51601E-01 4.36660E-01
- 5 3.25226E-01 -2.71906E-01
- 6 -2.96126E-01 -8.65398E-01
-6 0 *********** SCCC-trp-pro
- 1 2.05089E+00 -2.11116E+00
- 2 -1.06341E+00 -1.79907E+00
- 3 1.23995E+00 1.13593E+00
- 4 -8.47945E-01 -1.91831E+00
- 5 9.63432E-03 8.20902E-01
- 6 -1.86913E-01 2.76267E+00
-6 0 *********** SCCC-tyr-cys
- 1 6.24987E-01 1.15600E+00
- 2 1.38543E-01 2.05470E-01
- 3 -1.60708E-01 -3.38185E-02
- 4 -4.82787E-02 8.41805E-02
- 5 -1.59545E-01 -4.12736E-02
- 6 -1.53462E-02 1.26006E-02
-6 0 *********** SCCC-tyr-met
- 1 5.27289E-01 9.88530E-01
- 2 -2.70752E-02 3.27078E-01
- 3 -2.98182E-01 1.90322E-03
- 4 -1.37498E-01 8.07606E-02
- 5 -1.33565E-01 -4.47601E-02
- 6 -3.77703E-02 -3.85862E-02
-6 0 *********** SCCC-tyr-phe
- 1 4.83602E-01 1.06812E+00
- 2 -5.64058E-02 2.85156E-01
- 3 -2.72616E-01 -1.59982E-02
- 4 -1.23063E-01 8.96891E-02
- 5 -1.45266E-01 -4.25057E-02
- 6 -3.52482E-02 -2.43408E-02
-6 0 *********** SCCC-tyr-ile
- 1 7.00681E-01 8.80187E-01
- 2 7.79750E-03 3.90088E-01
- 3 -3.00525E-01 8.72277E-03
- 4 -1.63017E-01 8.88579E-02
- 5 -1.16223E-01 -4.79997E-02
- 6 -5.33477E-02 -7.81778E-02
-6 0 *********** SCCC-tyr-leu
- 1 5.02019E-01 1.05572E+00
- 2 -1.42403E-01 3.30564E-01
- 3 -3.37974E-01 -3.32434E-02
- 4 -1.42606E-01 6.44307E-02
- 5 -1.16191E-01 -5.73138E-02
- 6 -2.96851E-02 -4.27292E-02
-6 0 *********** SCCC-tyr-val
- 1 6.36163E-01 9.09527E-01
- 2 -6.19285E-02 3.89862E-01
- 3 -3.18010E-01 -1.15151E-03
- 4 -1.65628E-01 8.19066E-02
- 5 -1.06425E-01 -5.63880E-02
- 6 -4.90251E-02 -8.03480E-02
-6 0 *********** SCCC-tyr-trp
- 1 5.23074E-01 9.84639E-01
- 2 3.45286E-02 2.73716E-01
- 3 -2.32869E-01 7.00200E-03
- 4 -1.16097E-01 1.04172E-01
- 5 -1.49185E-01 -3.19522E-02
- 6 -4.26037E-02 -2.56455E-02
-6 0 *********** SCCC-tyr-tyr
- 1 4.82991E-01 1.05925E+00
- 2 -5.00905E-02 2.84085E-01
- 3 -2.70095E-01 -1.20070E-02
- 4 -1.23759E-01 9.25586E-02
- 5 -1.46579E-01 -4.10850E-02
- 6 -3.62205E-02 -1.91292E-02
-6 0 *********** SCCC-tyr-ala
- 1 3.50972E-01 9.18529E-01
- 2 -6.39874E-02 2.94071E-01
- 3 -2.97026E-01 1.17327E-02
- 4 -1.32511E-01 9.53654E-02
- 5 -1.33880E-01 -3.48586E-02
- 6 -3.89830E-02 -3.20247E-02
-6 0 *********** SCCC-tyr-gly
- 1 -3.10423E-01 -1.44986E+00
- 2 2.68664E-01 -1.23816E-01
- 3 -1.40153E-01 -2.63547E-01
- 4 -5.56126E-02 6.16195E-02
- 5 -6.48660E-03 -7.50127E-02
- 6 -6.30250E-02 -4.38229E-01
-6 0 *********** SCCC-tyr-thr
- 1 4.22990E-01 1.07838E+00
- 2 -1.91985E-01 2.51424E-01
- 3 -2.65052E-01 -1.50556E-01
- 4 -1.07905E-01 4.36114E-02
- 5 -8.76546E-02 -5.99876E-02
- 6 -3.78330E-02 -6.14384E-02
-6 0 *********** SCCC-tyr-ser
- 1 9.87886E-01 1.36339E+00
- 2 9.32898E-02 1.73190E-01
- 3 -7.77915E-02 -1.89577E-01
- 4 6.69395E-02 4.79750E-02
- 5 -9.58565E-02 -3.99793E-02
- 6 2.44360E-03 1.18981E-02
-6 0 *********** SCCC-tyr-gln
- 1 5.78628E-01 9.99929E-01
- 2 1.12167E-01 2.92817E-01
- 3 -2.26094E-01 1.80037E-02
- 4 -1.01705E-01 9.05918E-02
- 5 -1.50426E-01 -3.30887E-02
- 6 -3.61936E-02 -1.03155E-02
-6 0 *********** SCCC-tyr-asn
- 1 3.64161E-01 1.12751E+00
- 2 3.06439E-01 1.28891E-01
- 3 -8.29484E-02 1.66061E-02
- 4 1.93738E-02 1.02736E-01
- 5 -1.68598E-01 -2.94224E-02
- 6 1.33536E-02 6.09864E-02
-6 0 *********** SCCC-tyr-glu
- 1 6.43778E-01 1.07914E+00
- 2 6.68468E-02 2.98558E-01
- 3 -2.30189E-01 -1.09329E-02
- 4 -9.92603E-02 8.05593E-02
- 5 -1.42769E-01 -4.23907E-02
- 6 -3.25037E-02 -1.59568E-02
-6 0 *********** SCCC-tyr-asp
- 1 3.53271E-01 1.25806E+00
- 2 2.64172E-02 1.43050E-01
- 3 -1.84971E-01 -4.59769E-02
- 4 -5.52261E-02 9.99940E-02
- 5 -1.93195E-01 -5.15819E-02
- 6 1.08132E-03 2.32952E-02
-6 0 *********** SCCC-tyr-his
- 1 7.03805E-01 1.25026E+00
- 2 1.98988E-01 2.71874E-01
- 3 -1.48827E-01 -3.21828E-02
- 4 -2.55129E-03 6.90244E-02
- 5 -1.32259E-01 -3.59772E-02
- 6 5.56321E-04 2.98027E-02
-6 0 *********** SCCC-tyr-arg
- 1 4.95442E-01 9.82505E-01
- 2 -6.30979E-02 3.42137E-01
- 3 -3.09784E-01 3.64336E-03
- 4 -1.40592E-01 8.34503E-02
- 5 -1.23934E-01 -4.52381E-02
- 6 -3.71473E-02 -4.02231E-02
-6 0 *********** SCCC-tyr-lys
- 1 4.60818E-01 9.77265E-01
- 2 -6.85366E-02 3.59299E-01
- 3 -3.18552E-01 8.36295E-03
- 4 -1.46488E-01 7.99203E-02
- 5 -1.24764E-01 -4.75067E-02
- 6 -3.86440E-02 -4.75867E-02
-6 0 *********** SCCC-tyr-pro
- 1 -1.43358E+01 -2.10206E+00
- 2 1.53249E+01 -2.32030E-01
- 3 -1.40349E+01 -5.69962E-01
- 4 1.39352E+01 -1.53945E-01
- 5 -1.39867E+01 -1.71566E-01
- 6 6.84512E+00 -7.11341E-01
-6 0 *********** SCCC-ala-cys
- 1 -4.72234E-02 -4.57745E-01
- 2 3.56775E-01 -4.90053E-01
- 3 -2.61589E-01 -1.47351E-01
- 4 1.52747E-01 -2.54017E-02
- 5 -2.65539E-01 -2.29734E-02
- 6 8.33854E-02 3.07298E-03
-6 0 *********** SCCC-ala-met
- 1 -1.03127E-01 -4.08371E-01
- 2 1.82092E-01 -3.50028E-01
- 3 -2.59257E-01 -9.65053E-02
- 4 1.40834E-01 1.16843E-02
- 5 -2.38310E-01 -1.23107E-02
- 6 7.10268E-02 -1.98458E-02
-6 0 *********** SCCC-ala-phe
- 1 -8.17274E-02 -4.06801E-01
- 2 2.20384E-01 -3.65099E-01
- 3 -2.45776E-01 -1.07379E-01
- 4 1.52841E-01 2.39586E-04
- 5 -2.41882E-01 -1.95839E-02
- 6 7.57888E-02 -1.73280E-02
-6 0 *********** SCCC-ala-ile
- 1 -1.19760E-01 -4.46679E-01
- 2 7.95757E-02 -3.59717E-01
- 3 -2.80051E-01 -1.02623E-01
- 4 8.18465E-02 2.41845E-02
- 5 -2.24914E-01 -7.94906E-03
- 6 4.80583E-02 -3.02887E-02
-6 0 *********** SCCC-ala-leu
- 1 -8.56590E-02 -4.04951E-01
- 2 1.48218E-01 -3.49390E-01
- 3 -2.49709E-01 -1.04514E-01
- 4 1.43924E-01 9.09383E-03
- 5 -2.36775E-01 -1.74153E-02
- 6 6.79240E-02 -2.50369E-02
-6 0 *********** SCCC-ala-val
- 1 -1.10682E-01 -4.31077E-01
- 2 7.47146E-02 -3.38920E-01
- 3 -2.66845E-01 -1.04154E-01
- 4 9.10318E-02 1.56650E-02
- 5 -2.26267E-01 -1.52883E-02
- 6 4.82302E-02 -3.43669E-02
-6 0 *********** SCCC-ala-trp
- 1 -9.80232E-02 -4.11407E-01
- 2 2.23312E-01 -3.67078E-01
- 3 -2.51113E-01 -1.02750E-01
- 4 1.43110E-01 2.11031E-03
- 5 -2.39177E-01 -1.75085E-02
- 6 7.36262E-02 -1.22768E-02
-6 0 *********** SCCC-ala-tyr
- 1 -8.35871E-02 -4.05962E-01
- 2 2.19559E-01 -3.63114E-01
- 3 -2.45825E-01 -1.06221E-01
- 4 1.53566E-01 7.31578E-04
- 5 -2.41598E-01 -1.93763E-02
- 6 7.59375E-02 -2.17717E-02
-6 0 *********** SCCC-ala-ala
- 1 -1.12072E-01 -3.55877E-01
- 2 1.79448E-01 -2.69909E-01
- 3 -2.46881E-01 -7.17584E-02
- 4 1.77527E-01 1.58803E-02
- 5 -2.42365E-01 -1.05245E-02
- 6 7.90238E-02 -2.15854E-02
-6 0 *********** SCCC-ala-gly
- 1 -1.14363E+00 1.31306E-01
- 2 4.79888E-01 2.36611E-01
- 3 -7.90134E-02 -1.27081E-01
- 4 -5.99170E-02 8.76003E-02
- 5 -2.76277E-02 -1.06128E-05
- 6 -2.45918E-02 -1.68238E-01
-6 0 *********** SCCC-ala-thr
- 1 -5.15330E-02 -4.00985E-01
- 2 1.80424E-01 -3.62093E-01
- 3 -2.33610E-01 -1.18466E-01
- 4 9.15995E-02 9.48742E-03
- 5 -2.35524E-01 -1.99568E-02
- 6 4.94697E-02 -3.93897E-02
-6 0 *********** SCCC-ala-ser
- 1 7.50194E-02 -5.78525E-01
- 2 3.01747E-01 -6.93358E-01
- 3 -2.86366E-01 -2.68207E-01
- 4 6.21866E-02 -8.34327E-02
- 5 -3.13864E-01 -5.42099E-02
- 6 4.17846E-02 -5.25894E-04
-6 0 *********** SCCC-ala-gln
- 1 -1.04064E-01 -4.21506E-01
- 2 2.65529E-01 -3.88428E-01
- 3 -2.65512E-01 -1.01935E-01
- 4 1.44301E-01 3.51838E-03
- 5 -2.45250E-01 -1.13032E-02
- 6 7.85852E-02 -5.72991E-03
-6 0 *********** SCCC-ala-asn
- 1 -7.09877E-02 -4.01600E-01
- 2 5.68618E-01 -4.04161E-01
- 3 -2.55980E-01 -1.15102E-01
- 4 2.44533E-01 -3.24625E-02
- 5 -2.97769E-01 -2.14430E-02
- 6 1.16416E-01 9.17882E-03
-6 0 *********** SCCC-ala-glu
- 1 -7.56173E-02 -4.46306E-01
- 2 2.53680E-01 -4.32546E-01
- 3 -2.64285E-01 -1.27345E-01
- 4 1.25118E-01 -7.55815E-03
- 5 -2.48157E-01 -1.80572E-02
- 6 7.05856E-02 -7.98159E-03
-6 0 *********** SCCC-ala-asp
- 1 -3.71504E-02 -4.13112E-01
- 2 4.32148E-01 -4.26733E-01
- 3 -2.35568E-01 -1.25450E-01
- 4 2.13724E-01 -2.56847E-02
- 5 -2.64058E-01 -2.05016E-02
- 6 1.00963E-01 8.29918E-03
-6 0 *********** SCCC-ala-his
- 1 -3.33788E-02 -4.71157E-01
- 2 4.27097E-01 -5.11784E-01
- 3 -2.78457E-01 -1.65469E-01
- 4 1.53039E-01 -3.99350E-02
- 5 -2.95105E-01 -2.36970E-02
- 6 8.02113E-02 1.46523E-02
-6 0 *********** SCCC-ala-arg
- 1 -1.04573E-01 -3.97009E-01
- 2 1.65555E-01 -3.22867E-01
- 3 -2.55674E-01 -9.28299E-02
- 4 1.46464E-01 9.69913E-03
- 5 -2.38133E-01 -1.22190E-02
- 6 6.76459E-02 -2.41947E-02
-6 0 *********** SCCC-ala-lys
- 1 -1.07988E-01 -3.83821E-01
- 2 1.73039E-01 -2.98455E-01
- 3 -2.56152E-01 -8.52959E-02
- 4 1.50522E-01 1.26872E-02
- 5 -2.42498E-01 -1.15646E-02
- 6 7.07238E-02 -2.52455E-02
-6 0 *********** SCCC-ala-pro
- 1 -3.65783E+01 -1.73364E-01
- 2 2.05370E+01 3.29453E-01
- 3 3.61601E-01 2.95808E-01
- 4 -2.02371E+01 -1.26263E-01
- 5 3.48729E+01 -6.63178E-02
- 6 -2.02682E+01 1.96069E-01
-6 0 *********** SCCC-gly-cys
+20
+1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+4 0 *********** SCCC-cys-cys
+ 1 -4.55603E-01 9.65298E-01
+ 2 1.95846E-01 3.64979E-02
+ 3 1.27866E-01 -3.36766E-02
+ 4 -7.49954E-02 5.32498E-02
+4 0 *********** SCCC-cys-met
+ 1 -4.71114E-01 7.60987E-01
+ 2 2.41181E-01 -1.03322E-01
+ 3 1.43073E-01 -2.21854E-02
+ 4 -2.93892E-02 1.08616E-02
+4 0 *********** SCCC-cys-phe
+ 1 -5.43396E-01 7.51679E-01
+ 2 2.52192E-01 -7.71157E-02
+ 3 1.40708E-01 -3.86572E-02
+ 4 -4.11594E-02 2.05621E-02
+4 0 *********** SCCC-cys-ile
+ 1 -4.15806E-01 8.73796E-01
+ 2 2.29085E-01 -1.02595E-01
+ 3 1.21883E-01 -9.13890E-03
+ 4 -2.22851E-02 1.91175E-02
+4 0 *********** SCCC-cys-leu
+ 1 -5.26311E-01 7.03011E-01
+ 2 2.80452E-01 -1.19168E-01
+ 3 1.34515E-01 -3.58673E-02
+ 4 -2.40376E-02 9.69179E-03
+4 0 *********** SCCC-cys-val
+ 1 -4.50652E-01 8.05820E-01
+ 2 2.48129E-01 -1.17441E-01
+ 3 1.28793E-01 -1.49132E-02
+ 4 -1.99449E-02 1.32748E-02
+4 0 *********** SCCC-cys-trp
+ 1 -4.95125E-01 8.17010E-01
+ 2 2.15768E-01 -6.24687E-02
+ 3 1.40598E-01 -2.33209E-02
+ 4 -4.46050E-02 1.94235E-02
+4 0 *********** SCCC-cys-tyr
+ 1 -5.34800E-01 7.50959E-01
+ 2 2.51394E-01 -8.01634E-02
+ 3 1.41953E-01 -3.79765E-02
+ 4 -4.01579E-02 2.01270E-02
+4 0 *********** SCCC-cys-ala
+ 1 -4.83889E-01 6.03960E-01
+ 2 2.55589E-01 -1.33319E-01
+ 3 1.49137E-01 -5.00761E-02
+ 4 -2.06741E-02 1.06316E-03
+4 0 *********** SCCC-cys-gly
+ 1 1.20094E+00 2.04058E-01
+ 2 -2.22725E-01 3.56473E-02
+ 3 3.83425E-02 1.81060E-02
+ 4 2.28548E-02 8.61259E-02
+4 0 *********** SCCC-cys-thr
+ 1 -3.77258E-01 7.85308E-01
+ 2 1.49953E-01 -7.25764E-03
+ 3 1.49630E-01 -3.22510E-02
+ 4 -4.07046E-02 2.90824E-02
+4 0 *********** SCCC-cys-ser
+ 1 -4.81540E-01 1.07811E+00
+ 2 2.09279E-01 9.45944E-02
+ 3 9.23704E-02 -2.88524E-02
+ 4 -1.02030E-01 6.70852E-02
+4 0 *********** SCCC-cys-gln
+ 1 -3.87554E-01 9.02705E-01
+ 2 1.74805E-01 -3.32422E-02
+ 3 1.45982E-01 -1.62072E-02
+ 4 -5.27937E-02 2.83693E-02
+4 0 *********** SCCC-cys-asn
+ 1 -3.70700E-01 9.94732E-01
+ 2 1.34714E-01 1.19083E-01
+ 3 1.16032E-01 -5.44814E-02
+ 4 -8.00815E-02 6.18519E-02
+4 0 *********** SCCC-cys-glu
+ 1 -4.29864E-01 9.28142E-01
+ 2 2.02016E-01 -2.67383E-02
+ 3 1.35661E-01 -2.12449E-02
+ 4 -5.61243E-02 3.68305E-02
+4 0 *********** SCCC-cys-asp
+ 1 -2.52349E-01 1.04564E+00
+ 2 7.83457E-02 9.28812E-02
+ 3 1.44901E-01 -1.95968E-02
+ 4 -9.85960E-02 4.74697E-02
+4 0 *********** SCCC-cys-his
+ 1 -4.66699E-01 1.01960E+00
+ 2 1.98413E-01 2.61999E-02
+ 3 1.09956E-01 -8.07657E-03
+ 4 -7.45758E-02 4.28546E-02
+4 0 *********** SCCC-cys-arg
+ 1 -4.30417E-01 7.40954E-01
+ 2 2.24651E-01 -1.22910E-01
+ 3 1.50932E-01 -2.40954E-02
+ 4 -2.74423E-02 8.27042E-03
+4 0 *********** SCCC-cys-lys
+ 1 -4.67892E-01 6.80128E-01
+ 2 2.62052E-01 -1.43745E-01
+ 3 1.37999E-01 -3.02356E-02
+ 4 -1.46706E-02 2.84023E-03
+4 0 *********** SCCC-cys-pro
+ 1 -7.02091E-01 1.00140E+00
+ 2 2.07932E-01 1.73568E-01
+ 3 1.52497E-01 4.91816E-02
+ 4 -1.66631E-01 -4.06736E-02
+4 0 *********** SCCC-met-cys
+ 1 -4.42033E-01 5.40221E-01
+ 2 -7.19269E-02 -5.83381E-02
+ 3 5.06300E-02 5.91374E-03
+ 4 -3.06477E-02 7.69493E-03
+4 0 *********** SCCC-met-met
+ 1 -3.80151E-01 4.08235E-01
+ 2 -1.32467E-02 -2.03466E-02
+ 3 2.32344E-02 1.47494E-02
+ 4 -2.18032E-02 -1.81317E-03
+4 0 *********** SCCC-met-phe
+ 1 -4.12081E-01 3.97153E-01
+ 2 -1.01234E-02 -2.48314E-02
+ 3 2.61280E-02 1.71898E-02
+ 4 -2.43607E-02 -2.72779E-03
+4 0 *********** SCCC-met-ile
+ 1 -3.70397E-01 4.83444E-01
+ 2 -3.81252E-02 -2.93627E-02
+ 3 2.84816E-02 6.10235E-03
+ 4 -2.03401E-02 3.65369E-03
+4 0 *********** SCCC-met-leu
+ 1 -3.84551E-01 3.68011E-01
+ 2 4.38518E-03 -1.18971E-02
+ 3 2.00069E-02 1.65791E-02
+ 4 -2.13427E-02 -2.57694E-03
+4 0 *********** SCCC-met-val
+ 1 -3.71389E-01 4.38942E-01
+ 2 -2.05676E-02 -2.22868E-02
+ 3 2.41561E-02 1.09053E-02
+ 4 -2.05373E-02 8.06848E-04
+4 0 *********** SCCC-met-trp
+ 1 -4.10891E-01 4.37976E-01
+ 2 -2.77981E-02 -3.48201E-02
+ 3 3.03730E-02 1.46661E-02
+ 4 -2.46401E-02 -1.20686E-03
+4 0 *********** SCCC-met-tyr
+ 1 -4.08076E-01 3.97592E-01
+ 2 -1.01833E-02 -2.39038E-02
+ 3 2.57854E-02 1.69156E-02
+ 4 -2.41161E-02 -2.56675E-03
+4 0 *********** SCCC-met-ala
+ 1 -3.54616E-01 3.02973E-01
+ 2 2.16168E-02 -3.67977E-04
+ 3 1.45739E-02 1.81415E-02
+ 4 -1.79436E-02 -3.96459E-03
+4 0 *********** SCCC-met-gly
+ 1 7.05567E-01 3.10084E-01
+ 2 1.25016E-01 2.75261E-02
+ 3 4.64330E-02 4.30485E-02
+ 4 7.31928E-04 3.22684E-02
+4 0 *********** SCCC-met-thr
+ 1 -3.77492E-01 4.31285E-01
+ 2 -3.91945E-02 -3.09277E-02
+ 3 2.78681E-02 1.16254E-02
+ 4 -2.06920E-02 -1.15606E-03
+4 0 *********** SCCC-met-ser
+ 1 -4.77373E-01 6.03159E-01
+ 2 -9.65197E-02 -8.07901E-02
+ 3 6.83339E-02 4.71440E-04
+ 4 -3.56763E-02 1.68021E-02
+4 0 *********** SCCC-met-gln
+ 1 -3.89750E-01 5.00505E-01
+ 2 -5.57875E-02 -4.01181E-02
+ 3 3.61437E-02 7.13884E-03
+ 4 -2.44424E-02 3.20141E-03
+4 0 *********** SCCC-met-asn
+ 1 -4.37272E-01 5.59017E-01
+ 2 -9.01724E-02 -6.36490E-02
+ 3 5.60663E-02 1.24581E-03
+ 4 -2.96767E-02 1.05188E-02
+4 0 *********** SCCC-met-glu
+ 1 -4.09213E-01 5.16766E-01
+ 2 -5.89015E-02 -4.48149E-02
+ 3 4.07367E-02 6.19682E-03
+ 4 -2.66186E-02 5.34112E-03
+4 0 *********** SCCC-met-asp
+ 1 -3.89525E-01 5.77519E-01
+ 2 -1.02402E-01 -5.64349E-02
+ 3 5.16894E-02 -3.22193E-03
+ 4 -2.65854E-02 1.07219E-02
+4 0 *********** SCCC-met-his
+ 1 -4.50410E-01 5.61700E-01
+ 2 -7.85717E-02 -6.63989E-02
+ 3 5.36455E-02 3.90730E-03
+ 4 -3.01252E-02 9.50125E-03
+4 0 *********** SCCC-met-arg
+ 1 -3.57078E-01 3.96667E-01
+ 2 -8.94391E-03 -1.59360E-02
+ 3 2.05189E-02 1.44722E-02
+ 4 -1.99195E-02 -1.46327E-03
+4 0 *********** SCCC-met-lys
+ 1 -3.54616E-01 3.55248E-01
+ 2 8.91179E-03 -7.06650E-03
+ 3 1.62862E-02 1.57910E-02
+ 4 -1.82233E-02 -2.25638E-03
+4 0 *********** SCCC-met-pro
+ 1 -6.09554E-01 5.47230E-01
+ 2 -6.90890E-02 -1.30340E-01
+ 3 6.56985E-02 3.67062E-02
+ 4 -4.53500E-02 -1.31158E-02
+4 0 *********** SCCC-phe-cys
+ 1 -4.62579E-01 4.10888E-01
+ 2 -2.26015E-01 -1.46696E-01
+ 3 -1.94976E-02 -1.11131E-01
+ 4 -5.01894E-02 -1.27132E-02
+4 0 *********** SCCC-phe-met
+ 1 -3.78872E-01 2.75711E-01
+ 2 -1.59495E-01 -4.07052E-02
+ 3 -7.52546E-02 -9.37566E-02
+ 4 -2.65095E-02 -3.99488E-02
+4 0 *********** SCCC-phe-phe
+ 1 -4.00143E-01 2.57150E-01
+ 2 -1.51048E-01 -5.67289E-02
+ 3 -7.24239E-02 -9.40932E-02
+ 4 -3.19414E-02 -3.87639E-02
+4 0 *********** SCCC-phe-ile
+ 1 -3.88149E-01 3.52969E-01
+ 2 -1.93576E-01 -5.53308E-02
+ 3 -6.39139E-02 -9.09914E-02
+ 4 -2.47252E-02 -2.93166E-02
+4 0 *********** SCCC-phe-leu
+ 1 -3.70079E-01 2.35036E-01
+ 2 -1.45513E-01 -2.07186E-02
+ 3 -9.01374E-02 -9.11654E-02
+ 4 -2.56875E-02 -4.08861E-02
+4 0 *********** SCCC-phe-val
+ 1 -3.77876E-01 3.07980E-01
+ 2 -1.74240E-01 -3.92289E-02
+ 3 -7.45993E-02 -9.02785E-02
+ 4 -2.30187E-02 -3.49072E-02
+4 0 *********** SCCC-phe-trp
+ 1 -4.12306E-01 2.98390E-01
+ 2 -1.65326E-01 -7.91134E-02
+ 3 -5.53723E-02 -9.47400E-02
+ 4 -3.33398E-02 -3.58108E-02
+4 0 *********** SCCC-phe-tyr
+ 1 -3.97064E-01 2.58593E-01
+ 2 -1.52086E-01 -5.41079E-02
+ 3 -7.35758E-02 -9.43540E-02
+ 4 -3.15097E-02 -3.87731E-02
+4 0 *********** SCCC-phe-ala
+ 1 -3.36157E-01 1.77519E-01
+ 2 -1.17424E-01 9.69066E-03
+ 3 -1.01062E-01 -8.78362E-02
+ 4 -2.22926E-02 -4.51096E-02
+4 0 *********** SCCC-phe-gly
+ 1 6.01182E-01 3.73727E-01
+ 2 3.30566E-01 4.52419E-02
+ 3 1.00750E-01 -6.31009E-02
+ 4 3.63753E-04 3.44768E-02
+4 0 *********** SCCC-phe-thr
+ 1 -3.95492E-01 3.00352E-01
+ 2 -1.60716E-01 -8.77644E-02
+ 3 -4.19793E-02 -9.88401E-02
+ 4 -2.69269E-02 -3.01506E-02
+4 0 *********** SCCC-phe-ser
+ 1 -5.09102E-01 4.86450E-01
+ 2 -2.67160E-01 -2.00589E-01
+ 3 1.62078E-02 -1.17665E-01
+ 4 -6.48941E-02 1.30471E-02
+4 0 *********** SCCC-phe-gln
+ 1 -4.13035E-01 3.70012E-01
+ 2 -1.99598E-01 -9.56424E-02
+ 3 -4.25024E-02 -1.02604E-01
+ 4 -3.86357E-02 -2.84432E-02
+4 0 *********** SCCC-phe-asn
+ 1 -4.74125E-01 4.37822E-01
+ 2 -2.34663E-01 -1.77057E-01
+ 3 4.97599E-04 -1.14090E-01
+ 4 -5.52800E-02 -2.01378E-03
+4 0 *********** SCCC-phe-glu
+ 1 -4.28227E-01 3.85340E-01
+ 2 -2.11873E-01 -1.05524E-01
+ 3 -4.15752E-02 -1.04415E-01
+ 4 -4.19641E-02 -2.34032E-02
+4 0 *********** SCCC-phe-asp
+ 1 -4.43901E-01 4.61468E-01
+ 2 -2.41169E-01 -1.58233E-01
+ 3 -2.36848E-03 -1.19346E-01
+ 4 -6.11572E-02 -6.37633E-03
+4 0 *********** SCCC-phe-his
+ 1 -4.75995E-01 4.33527E-01
+ 2 -2.35847E-01 -1.59983E-01
+ 3 -5.89940E-03 -1.10557E-01
+ 4 -4.73175E-02 -7.16909E-03
+4 0 *********** SCCC-phe-arg
+ 1 -3.59730E-01 2.67583E-01
+ 2 -1.52185E-01 -2.40627E-02
+ 3 -8.10757E-02 -8.94407E-02
+ 4 -2.49723E-02 -4.03733E-02
+4 0 *********** SCCC-phe-lys
+ 1 -3.46674E-01 2.28404E-01
+ 2 -1.39061E-01 -1.64743E-03
+ 3 -9.34945E-02 -8.62849E-02
+ 4 -1.92633E-02 -4.11896E-02
+4 0 *********** SCCC-phe-pro
+ 1 -6.17241E-01 4.52603E-01
+ 2 -1.85757E-01 -3.00525E-01
+ 3 7.35871E-02 -1.20146E-01
+ 4 -4.20338E-02 -8.11095E-02
+4 0 *********** SCCC-ile-cys
+ 1 -6.04603E-01 6.22953E-01
+ 2 -1.07202E-01 -9.11979E-02
+ 3 1.80581E-01 -5.32300E-02
+ 4 -5.33906E-02 2.69991E-02
+4 0 *********** SCCC-ile-met
+ 1 -4.98356E-01 4.32072E-01
+ 2 -8.68054E-03 -1.44039E-02
+ 3 9.97463E-02 -3.66053E-02
+ 4 -2.99125E-02 -1.76010E-03
+4 0 *********** SCCC-ile-phe
+ 1 -5.36203E-01 4.14006E-01
+ 2 -8.15075E-03 -1.25844E-02
+ 3 1.12158E-01 -3.54614E-02
+ 4 -3.86935E-02 -3.72408E-03
+4 0 *********** SCCC-ile-ile
+ 1 -4.98343E-01 5.32806E-01
+ 2 -4.01467E-02 -3.69391E-02
+ 3 1.01120E-01 -5.31072E-02
+ 4 -2.39305E-02 1.25986E-02
+4 0 *********** SCCC-ile-leu
+ 1 -4.98957E-01 3.77555E-01
+ 2 1.41813E-02 5.96541E-03
+ 3 9.45394E-02 -4.12774E-02
+ 4 -3.13142E-02 -1.96469E-03
+4 0 *********** SCCC-ile-val
+ 1 -4.92613E-01 4.72043E-01
+ 2 -1.58054E-02 -2.05223E-02
+ 3 9.47257E-02 -4.57798E-02
+ 4 -2.58082E-02 6.16207E-03
+4 0 *********** SCCC-ile-trp
+ 1 -5.40919E-01 4.71089E-01
+ 2 -3.11140E-02 -3.60351E-02
+ 3 1.19081E-01 -3.23843E-02
+ 4 -3.76778E-02 -8.72224E-04
+4 0 *********** SCCC-ile-tyr
+ 1 -5.31300E-01 4.14938E-01
+ 2 -7.95744E-03 -1.20449E-02
+ 3 1.10947E-01 -3.60107E-02
+ 4 -3.79362E-02 -3.40210E-03
+4 0 *********** SCCC-ile-ala
+ 1 -4.53534E-01 3.02214E-01
+ 2 3.54264E-02 2.04753E-02
+ 3 8.37150E-02 -3.51964E-02
+ 4 -2.54678E-02 -6.69398E-03
+4 0 *********** SCCC-ile-gly
+ 1 8.95801E-01 4.66810E-01
+ 2 2.18402E-01 6.07274E-02
+ 3 2.19337E-01 1.09960E-01
+ 4 4.59913E-02 9.51908E-02
+4 0 *********** SCCC-ile-thr
+ 1 -4.97030E-01 4.69824E-01
+ 2 -4.67561E-02 -4.01289E-02
+ 3 1.16124E-01 -2.32173E-02
+ 4 -3.33238E-02 -6.74730E-04
+4 0 *********** SCCC-ile-ser
+ 1 -6.82521E-01 7.46737E-01
+ 2 -1.66838E-01 -1.58009E-01
+ 3 2.50198E-01 -7.33204E-02
+ 4 -7.21986E-02 7.43273E-02
+4 0 *********** SCCC-ile-gln
+ 1 -5.25896E-01 5.61891E-01
+ 2 -7.20761E-02 -6.01625E-02
+ 3 1.32414E-01 -4.25460E-02
+ 4 -3.51978E-02 8.25566E-03
+4 0 *********** SCCC-ile-asn
+ 1 -6.07023E-01 6.64836E-01
+ 2 -1.42383E-01 -1.14830E-01
+ 3 2.05263E-01 -5.70534E-02
+ 4 -5.57412E-02 4.15312E-02
+4 0 *********** SCCC-ile-glu
+ 1 -5.54083E-01 5.82928E-01
+ 2 -7.96853E-02 -6.47652E-02
+ 3 1.44558E-01 -5.23117E-02
+ 4 -3.98567E-02 1.57250E-02
+4 0 *********** SCCC-ile-asp
+ 1 -5.50756E-01 6.98214E-01
+ 2 -1.58363E-01 -1.20098E-01
+ 3 1.94070E-01 -5.54957E-02
+ 4 -4.63837E-02 3.30493E-02
+4 0 *********** SCCC-ile-his
+ 1 -6.22802E-01 6.58897E-01
+ 2 -1.17083E-01 -1.10923E-01
+ 3 1.87541E-01 -5.44786E-02
+ 4 -5.27283E-02 3.60895E-02
+4 0 *********** SCCC-ile-arg
+ 1 -4.68316E-01 4.20180E-01
+ 2 -1.60693E-03 -1.14180E-02
+ 3 9.02561E-02 -3.53904E-02
+ 4 -2.60790E-02 -1.83804E-03
+4 0 *********** SCCC-ile-lys
+ 1 -4.60625E-01 3.66307E-01
+ 2 2.28230E-02 6.88499E-03
+ 3 8.09885E-02 -3.86622E-02
+ 4 -2.37433E-02 -8.00729E-04
+4 0 *********** SCCC-ile-pro
+ 1 -9.11814E-01 7.56200E-01
+ 2 -1.68031E-01 -3.15787E-01
+ 3 3.77243E-01 6.35252E-02
+ 4 -1.52893E-01 6.08670E-02
+4 0 *********** SCCC-leu-cys
+ 1 -5.92878E-01 2.63423E-01
+ 2 -4.46107E-01 1.45946E-02
+ 3 8.85691E-02 1.25335E-01
+ 4 3.46958E-03 -3.44148E-02
+4 0 *********** SCCC-leu-met
+ 1 -5.04044E-01 1.18074E-01
+ 2 -2.75735E-01 1.37015E-01
+ 3 1.80417E-02 1.20871E-01
+ 4 -1.96858E-02 -6.73149E-02
+4 0 *********** SCCC-leu-phe
+ 1 -5.23790E-01 7.82255E-02
+ 2 -3.03285E-01 1.12738E-01
+ 3 2.60212E-02 1.47188E-01
+ 4 -9.12905E-03 -6.95404E-02
+4 0 *********** SCCC-leu-ile
+ 1 -5.22824E-01 2.10748E-01
+ 2 -3.07049E-01 1.41478E-01
+ 3 4.78934E-02 8.75128E-02
+ 4 -2.40663E-02 -6.14111E-02
+4 0 *********** SCCC-leu-leu
+ 1 -4.96301E-01 5.48648E-02
+ 2 -2.65529E-01 1.68077E-01
+ 3 2.10832E-02 1.38336E-01
+ 4 -1.97833E-02 -7.72021E-02
+4 0 *********** SCCC-leu-val
+ 1 -5.09257E-01 1.53623E-01
+ 2 -2.82467E-01 1.55153E-01
+ 3 3.36493E-02 1.03923E-01
+ 4 -2.47317E-02 -6.84244E-02
+4 0 *********** SCCC-leu-trp
+ 1 -5.36915E-01 1.41614E-01
+ 2 -3.16123E-01 8.21513E-02
+ 3 3.10676E-02 1.28035E-01
+ 4 -1.05901E-02 -5.87549E-02
+4 0 *********** SCCC-leu-tyr
+ 1 -5.20832E-01 8.15940E-02
+ 2 -3.00203E-01 1.16652E-01
+ 3 2.49572E-02 1.45017E-01
+ 4 -1.03220E-02 -6.96037E-02
+4 0 *********** SCCC-leu-ala
+ 1 -4.53690E-01 1.60448E-02
+ 2 -2.01402E-01 1.80136E-01
+ 3 -6.40669E-03 1.38012E-01
+ 4 -2.27126E-02 -6.80365E-02
+4 0 *********** SCCC-leu-gly
+ 1 5.13032E-01 5.43657E-01
+ 2 4.85228E-01 -2.44057E-01
+ 3 6.72842E-02 1.86750E-01
+ 4 -1.00748E-02 -3.90944E-02
+4 0 *********** SCCC-leu-thr
+ 1 -5.11060E-01 1.84664E-01
+ 2 -2.91864E-01 4.05042E-02
+ 3 5.02939E-03 1.09568E-01
+ 4 -5.49041E-03 -4.27811E-02
+4 0 *********** SCCC-leu-ser
+ 1 -6.55966E-01 3.49434E-01
+ 2 -5.56569E-01 -4.24392E-02
+ 3 1.67513E-01 1.18900E-01
+ 4 1.08718E-02 3.65601E-03
+4 0 *********** SCCC-leu-gln
+ 1 -5.39982E-01 2.45285E-01
+ 2 -3.44086E-01 6.50880E-02
+ 3 4.03263E-02 1.00921E-01
+ 4 -1.28837E-02 -4.48029E-02
+4 0 *********** SCCC-leu-asn
+ 1 -6.07636E-01 3.30162E-01
+ 2 -4.72874E-01 -5.25555E-02
+ 3 1.03963E-01 1.19980E-01
+ 4 5.25450E-03 -4.88500E-03
+4 0 *********** SCCC-leu-glu
+ 1 -5.58718E-01 2.42544E-01
+ 2 -3.81869E-01 6.88831E-02
+ 3 6.30436E-02 1.09829E-01
+ 4 -9.56560E-03 -4.83048E-02
+4 0 *********** SCCC-leu-asp
+ 1 -5.76809E-01 3.97867E-01
+ 2 -4.25845E-01 -4.30068E-02
+ 3 7.14207E-02 8.60899E-02
+ 4 -5.73144E-03 1.54473E-03
+4 0 *********** SCCC-leu-his
+ 1 -6.10042E-01 2.93401E-01
+ 2 -4.60094E-01 7.29031E-03
+ 3 1.05630E-01 1.06369E-01
+ 4 2.94319E-03 -2.77707E-02
+4 0 *********** SCCC-leu-arg
+ 1 -4.84492E-01 1.24026E-01
+ 2 -2.41674E-01 1.50040E-01
+ 3 7.75272E-03 1.12210E-01
+ 4 -2.47593E-02 -6.27088E-02
+4 0 *********** SCCC-leu-lys
+ 1 -4.71699E-01 6.92459E-02
+ 2 -2.22373E-01 1.85162E-01
+ 3 8.73867E-03 1.19745E-01
+ 4 -2.71969E-02 -7.09850E-02
+4 0 *********** SCCC-leu-pro
+ 1 -7.44731E-01 2.85611E-01
+ 2 -5.87121E-01 -2.89125E-01
+ 3 1.11616E-01 2.21559E-01
+ 4 -2.15154E-02 3.19252E-02
+4 0 *********** SCCC-val-cys
+ 1 -6.37671E-01 4.29531E-01
+ 2 -3.54652E-01 -9.45011E-02
+ 3 1.30803E-01 5.39195E-02
+ 4 1.68066E-02 -5.89187E-03
+4 0 *********** SCCC-val-met
+ 1 -5.19785E-01 2.30211E-01
+ 2 -2.02858E-01 5.02491E-02
+ 3 3.89614E-02 5.37683E-02
+ 4 1.11168E-02 -3.69718E-02
+4 0 *********** SCCC-val-phe
+ 1 -5.44730E-01 2.00795E-01
+ 2 -2.15635E-01 3.21726E-02
+ 3 4.76527E-02 7.31636E-02
+ 4 1.53060E-02 -4.12280E-02
+4 0 *********** SCCC-val-ile
+ 1 -5.37729E-01 3.36320E-01
+ 2 -2.39123E-01 3.72545E-02
+ 3 6.13247E-02 2.26126E-02
+ 4 6.42153E-03 -2.79011E-02
+4 0 *********** SCCC-val-leu
+ 1 -5.08982E-01 1.69477E-01
+ 2 -1.85919E-01 8.01706E-02
+ 3 3.52565E-02 6.27795E-02
+ 4 1.04221E-02 -4.18706E-02
+4 0 *********** SCCC-val-val
+ 1 -5.22276E-01 2.71776E-01
+ 2 -2.11599E-01 5.73754E-02
+ 3 4.72046E-02 3.69249E-02
+ 4 6.29363E-03 -3.41850E-02
+4 0 *********** SCCC-val-trp
+ 1 -5.61184E-01 2.64153E-01
+ 2 -2.34313E-01 -3.03607E-04
+ 3 5.74963E-02 6.30770E-02
+ 4 1.37481E-02 -3.39654E-02
+4 0 *********** SCCC-val-tyr
+ 1 -5.41140E-01 2.02967E-01
+ 2 -2.14128E-01 3.53404E-02
+ 3 4.65146E-02 7.12986E-02
+ 4 1.48945E-02 -4.10807E-02
+4 0 *********** SCCC-val-ala
+ 1 -4.63528E-01 1.08009E-01
+ 2 -1.37427E-01 1.04421E-01
+ 3 1.47077E-02 6.60091E-02
+ 4 1.01403E-02 -3.82779E-02
+4 0 *********** SCCC-val-gly
+ 1 7.80222E-01 5.62809E-01
+ 2 4.98015E-01 -5.06927E-02
+ 3 1.96403E-01 1.85531E-01
+ 4 5.49617E-02 3.22318E-02
+4 0 *********** SCCC-val-thr
+ 1 -5.36024E-01 2.87204E-01
+ 2 -2.23081E-01 -2.57248E-02
+ 3 4.58625E-02 5.62526E-02
+ 4 1.49919E-02 -2.83341E-02
+4 0 *********** SCCC-val-ser
+ 1 -7.36521E-01 5.92936E-01
+ 2 -4.71167E-01 -2.09715E-01
+ 3 2.46981E-01 3.63319E-02
+ 4 2.49886E-03 7.07794E-02
+4 0 *********** SCCC-val-gln
+ 1 -5.67291E-01 3.71453E-01
+ 2 -2.74806E-01 -2.75425E-02
+ 3 7.39046E-02 4.04525E-02
+ 4 1.46551E-02 -2.27218E-02
+4 0 *********** SCCC-val-asn
+ 1 -6.64590E-01 5.01935E-01
+ 2 -3.89259E-01 -1.62453E-01
+ 3 1.66000E-01 5.45842E-02
+ 4 9.89117E-03 2.04990E-02
+4 0 *********** SCCC-val-glu
+ 1 -5.89071E-01 3.85900E-01
+ 2 -3.02715E-01 -3.38776E-02
+ 3 9.27025E-02 4.14834E-02
+ 4 1.51151E-02 -2.06967E-02
+4 0 *********** SCCC-val-asp
+ 1 -6.27245E-01 5.48540E-01
+ 2 -3.72164E-01 -1.46947E-01
+ 3 1.39515E-01 2.80768E-02
+ 4 1.64719E-02 1.88088E-02
+4 0 *********** SCCC-val-his
+ 1 -6.59237E-01 4.70083E-01
+ 2 -3.71977E-01 -1.13978E-01
+ 3 1.50304E-01 3.90954E-02
+ 4 1.44891E-02 8.97853E-03
+4 0 *********** SCCC-val-arg
+ 1 -4.97016E-01 2.25840E-01
+ 2 -1.78561E-01 6.55208E-02
+ 3 2.88421E-02 4.79617E-02
+ 4 7.81065E-03 -3.59868E-02
+4 0 *********** SCCC-val-lys
+ 1 -4.80377E-01 1.69852E-01
+ 2 -1.56685E-01 9.80185E-02
+ 3 2.38504E-02 5.07570E-02
+ 4 5.44637E-03 -3.75260E-02
+4 0 *********** SCCC-val-pro
+ 1 -9.65053E-01 6.96480E-01
+ 2 -4.20317E-01 -5.55247E-01
+ 3 3.34534E-01 1.03603E-01
+ 4 -1.90510E-01 1.26764E-01
+4 0 *********** SCCC-trp-cys
+ 1 -2.78524E-01 4.85646E-01
+ 2 6.41275E-02 -2.16323E-01
+ 3 3.18075E-02 -2.93624E-02
+ 4 -2.22648E-02 7.05087E-03
+4 0 *********** SCCC-trp-met
+ 1 -2.30591E-01 4.06685E-01
+ 2 3.77207E-02 -1.78384E-01
+ 3 1.43886E-02 -4.18351E-02
+ 4 -1.23092E-02 4.18442E-03
+4 0 *********** SCCC-trp-phe
+ 1 -2.60440E-01 4.03440E-01
+ 2 5.68400E-02 -1.80060E-01
+ 3 1.15195E-02 -3.96156E-02
+ 4 -1.25504E-02 3.13314E-03
+4 0 *********** SCCC-trp-ile
+ 1 -2.16552E-01 4.53965E-01
+ 2 2.09254E-02 -1.95954E-01
+ 3 2.14445E-02 -3.54838E-02
+ 4 -1.43223E-02 6.53411E-03
+4 0 *********** SCCC-trp-leu
+ 1 -2.39189E-01 3.84951E-01
+ 2 4.15813E-02 -1.76380E-01
+ 3 6.21918E-03 -4.42101E-02
+ 4 -1.02856E-02 3.23994E-03
+4 0 *********** SCCC-trp-val
+ 1 -2.20970E-01 4.27583E-01
+ 2 2.66601E-02 -1.87827E-01
+ 3 1.61804E-02 -3.85142E-02
+ 4 -1.25531E-02 4.99406E-03
+4 0 *********** SCCC-trp-trp
+ 1 -2.54225E-01 4.25270E-01
+ 2 5.31925E-02 -1.83758E-01
+ 3 1.94121E-02 -3.58574E-02
+ 4 -1.48848E-02 3.88371E-03
+4 0 *********** SCCC-trp-tyr
+ 1 -2.56868E-01 4.03337E-01
+ 2 5.45916E-02 -1.79887E-01
+ 3 1.15892E-02 -4.02659E-02
+ 4 -1.24425E-02 3.36618E-03
+4 0 *********** SCCC-trp-ala
+ 1 -2.17129E-01 3.33640E-01
+ 2 3.23038E-02 -1.51703E-01
+ 3 -1.01237E-03 -5.25382E-02
+ 4 -6.86667E-03 2.97654E-03
+4 0 *********** SCCC-trp-gly
+ 1 5.94221E-01 1.67050E-01
+ 2 6.49413E-02 2.51562E-01
+ 3 4.24071E-02 2.99356E-02
+ 4 7.25430E-04 2.69304E-02
+4 0 *********** SCCC-trp-thr
+ 1 -2.22689E-01 4.05291E-01
+ 2 4.89623E-02 -1.57996E-01
+ 3 2.17295E-02 -4.04462E-02
+ 4 -1.10784E-02 5.11588E-03
+4 0 *********** SCCC-trp-ser
+ 1 -3.09857E-01 5.25488E-01
+ 2 7.36706E-02 -2.46687E-01
+ 3 4.02618E-02 -1.84896E-02
+ 4 -2.98467E-02 7.31333E-03
+4 0 *********** SCCC-trp-gln
+ 1 -2.30145E-01 4.56534E-01
+ 2 3.82070E-02 -1.90604E-01
+ 3 2.79157E-02 -3.82039E-02
+ 4 -1.71306E-02 7.82471E-03
+4 0 *********** SCCC-trp-asn
+ 1 -2.69658E-01 4.83847E-01
+ 2 6.85080E-02 -2.04815E-01
+ 3 3.21313E-02 -3.18899E-02
+ 4 -2.04228E-02 7.53084E-03
+4 0 *********** SCCC-trp-glu
+ 1 -2.49321E-01 4.72181E-01
+ 2 4.47376E-02 -2.05998E-01
+ 3 2.81910E-02 -3.45353E-02
+ 4 -1.92147E-02 7.74112E-03
+4 0 *********** SCCC-trp-asp
+ 1 -2.19803E-01 4.83941E-01
+ 2 3.98107E-02 -1.88327E-01
+ 3 3.78892E-02 -4.46591E-02
+ 4 -1.94208E-02 1.40890E-02
+4 0 *********** SCCC-trp-his
+ 1 -2.83887E-01 5.00226E-01
+ 2 6.19914E-02 -2.25158E-01
+ 3 3.72174E-02 -2.30486E-02
+ 4 -2.49218E-02 6.60551E-03
+4 0 *********** SCCC-trp-arg
+ 1 -2.09871E-01 3.95271E-01
+ 2 2.57150E-02 -1.69532E-01
+ 3 1.21004E-02 -4.50086E-02
+ 4 -1.03571E-02 4.93005E-03
+4 0 *********** SCCC-trp-lys
+ 1 -2.12544E-01 3.71164E-01
+ 2 2.58459E-02 -1.66757E-01
+ 3 5.22659E-03 -4.62493E-02
+ 4 -8.27350E-03 3.41783E-03
+4 0 *********** SCCC-trp-pro
+ 1 -4.42199E-01 5.02993E-01
+ 2 1.65099E-01 -2.50806E-01
+ 3 5.62381E-02 -9.12310E-03
+ 4 -3.65576E-02 2.98371E-03
+4 0 *********** SCCC-tyr-cys
+ 1 -4.45048E-01 3.51850E-01
+ 2 -1.56000E-01 -2.07395E-01
+ 3 4.54257E-02 -1.13902E-01
+ 4 -2.94059E-02 1.01806E-02
+4 0 *********** SCCC-tyr-met
+ 1 -3.59076E-01 2.42112E-01
+ 2 -1.24780E-01 -1.04515E-01
+ 3 -7.86907E-03 -1.11506E-01
+ 4 -4.63654E-03 -1.08826E-02
+4 0 *********** SCCC-tyr-phe
+ 1 -3.77667E-01 2.25542E-01
+ 2 -1.12647E-01 -1.16054E-01
+ 3 -5.00073E-03 -1.11364E-01
+ 4 -1.03726E-02 -1.09456E-02
+4 0 *********** SCCC-tyr-ile
+ 1 -3.72246E-01 3.08265E-01
+ 2 -1.52206E-01 -1.24337E-01
+ 3 -4.21208E-04 -1.07332E-01
+ 4 -2.98009E-03 -1.72568E-03
+4 0 *********** SCCC-tyr-leu
+ 1 -3.48424E-01 2.08197E-01
+ 2 -1.17477E-01 -8.54272E-02
+ 3 -2.08894E-02 -1.14484E-01
+ 4 -2.97589E-03 -1.22439E-02
+4 0 *********** SCCC-tyr-val
+ 1 -3.60127E-01 2.70511E-01
+ 2 -1.38881E-01 -1.07027E-01
+ 3 -9.07811E-03 -1.09077E-01
+ 4 -1.42119E-03 -6.39666E-03
+4 0 *********** SCCC-tyr-trp
+ 1 -3.90987E-01 2.59420E-01
+ 2 -1.19812E-01 -1.36990E-01
+ 3 8.92199E-03 -1.06309E-01
+ 4 -1.31699E-02 -8.39469E-03
+4 0 *********** SCCC-tyr-tyr
+ 1 -3.74966E-01 2.26930E-01
+ 2 -1.14291E-01 -1.14163E-01
+ 3 -5.85492E-03 -1.11965E-01
+ 4 -9.72865E-03 -1.08598E-02
+4 0 *********** SCCC-tyr-ala
+ 1 -3.12234E-01 1.57801E-01
+ 2 -1.01142E-01 -5.08100E-02
+ 3 -3.20892E-02 -1.13819E-01
+ 4 -3.03066E-04 -1.71860E-02
+4 0 *********** SCCC-tyr-gly
+ 1 5.21249E-01 3.73505E-01
+ 2 2.77449E-01 1.38874E-01
+ 3 1.28523E-01 -1.16458E-02
+ 4 2.12469E-02 4.66123E-02
+4 0 *********** SCCC-tyr-thr
+ 1 -3.74902E-01 2.58212E-01
+ 2 -1.11953E-01 -1.38220E-01
+ 3 1.84392E-02 -1.01615E-01
+ 4 -1.27215E-02 -6.08377E-03
+4 0 *********** SCCC-tyr-ser
+ 1 -4.90127E-01 4.11518E-01
+ 2 -1.80164E-01 -2.59300E-01
+ 3 7.59210E-02 -1.14620E-01
+ 4 -4.35756E-02 2.91465E-02
+4 0 *********** SCCC-tyr-gln
+ 1 -3.96272E-01 3.19344E-01
+ 2 -1.46228E-01 -1.57896E-01
+ 3 2.24448E-02 -1.10761E-01
+ 4 -1.60657E-02 -1.82447E-03
+4 0 *********** SCCC-tyr-asn
+ 1 -4.55058E-01 3.69713E-01
+ 2 -1.55377E-01 -2.29677E-01
+ 3 6.06865E-02 -1.10740E-01
+ 4 -3.66774E-02 1.57932E-02
+4 0 *********** SCCC-tyr-glu
+ 1 -4.11987E-01 3.32970E-01
+ 2 -1.54730E-01 -1.70628E-01
+ 3 2.47803E-02 -1.14047E-01
+ 4 -1.83778E-02 2.69377E-03
+4 0 *********** SCCC-tyr-asp
+ 1 -4.27679E-01 3.89628E-01
+ 2 -1.67273E-01 -2.13504E-01
+ 3 5.99795E-02 -1.17236E-01
+ 4 -3.51338E-02 1.27111E-02
+4 0 *********** SCCC-tyr-his
+ 1 -4.57549E-01 3.69384E-01
+ 2 -1.61130E-01 -2.19712E-01
+ 3 5.49814E-02 -1.08614E-01
+ 4 -3.01313E-02 1.46920E-02
+4 0 *********** SCCC-tyr-arg
+ 1 -3.40333E-01 2.35484E-01
+ 2 -1.23496E-01 -8.78982E-02
+ 3 -1.48072E-02 -1.09426E-01
+ 4 -2.20178E-03 -1.20122E-02
+4 0 *********** SCCC-tyr-lys
+ 1 -3.25541E-01 2.02599E-01
+ 2 -1.17571E-01 -6.65914E-02
+ 3 -2.65377E-02 -1.10293E-01
+ 4 2.04292E-03 -1.28717E-02
+4 0 *********** SCCC-tyr-pro
+ 1 -5.63016E-01 3.51117E-01
+ 2 -8.02641E-02 -3.73003E-01
+ 3 1.39426E-01 -1.23307E-01
+ 4 -8.75532E-02 -7.51550E-02
+4 0 *********** SCCC-ala-cys
+ 1 -3.77726E-01 5.98890E-01
+ 2 -2.97365E-01 1.52563E-01
+ 3 2.45306E-01 9.87104E-02
+ 4 -3.32744E-02 -4.90398E-03
+4 0 *********** SCCC-ala-met
+ 1 -3.37099E-01 4.08982E-01
+ 2 -1.14201E-01 1.59266E-01
+ 3 2.01176E-01 1.30610E-01
+ 4 -4.51059E-02 1.97629E-03
+4 0 *********** SCCC-ala-phe
+ 1 -3.77173E-01 3.94631E-01
+ 2 -1.44796E-01 1.47119E-01
+ 3 2.25901E-01 1.43875E-01
+ 4 -4.94759E-02 -8.09483E-03
+4 0 *********** SCCC-ala-ile
+ 1 -3.08743E-01 5.00302E-01
+ 2 -1.42373E-01 1.83090E-01
+ 3 1.90801E-01 8.07317E-02
+ 4 -3.96607E-02 1.15764E-02
+4 0 *********** SCCC-ala-leu
+ 1 -3.52027E-01 3.52741E-01
+ 2 -9.00989E-02 1.67136E-01
+ 3 2.21634E-01 1.37574E-01
+ 4 -5.19605E-02 -2.58277E-03
+4 0 *********** SCCC-ala-val
+ 1 -3.20525E-01 4.42837E-01
+ 2 -1.13915E-01 1.75920E-01
+ 3 1.97451E-01 1.03258E-01
+ 4 -4.55199E-02 9.28782E-03
+4 0 *********** SCCC-ala-trp
+ 1 -3.65472E-01 4.53849E-01
+ 2 -1.72051E-01 1.40110E-01
+ 3 2.07740E-01 1.29915E-01
+ 4 -4.16369E-02 -2.77301E-03
+4 0 *********** SCCC-ala-tyr
+ 1 -3.72513E-01 3.94795E-01
+ 2 -1.40660E-01 1.49201E-01
+ 3 2.24346E-01 1.43019E-01
+ 4 -4.93708E-02 -7.27975E-03
+4 0 *********** SCCC-ala-ala
+ 1 -3.35311E-01 2.89927E-01
+ 2 -3.40832E-02 1.42388E-01
+ 3 1.94384E-01 1.32260E-01
+ 4 -4.40129E-02 6.83620E-03
+4 0 *********** SCCC-ala-gly
+ 1 8.22151E-01 1.90559E-01
+ 2 2.80038E-01 -3.33499E-01
+ 3 1.83010E-01 1.85465E-01
+ 4 1.76027E-02 1.47276E-02
+4 0 *********** SCCC-ala-thr
+ 1 -3.33347E-01 4.61786E-01
+ 2 -1.71559E-01 1.22081E-01
+ 3 1.67931E-01 1.38621E-01
+ 4 -3.43815E-02 -4.49115E-03
+4 0 *********** SCCC-ala-ser
+ 1 -4.06949E-01 7.14967E-01
+ 2 -4.06057E-01 1.53751E-01
+ 3 2.89739E-01 4.70485E-02
+ 4 -1.53989E-02 3.02970E-03
+4 0 *********** SCCC-ala-gln
+ 1 -3.26276E-01 5.37287E-01
+ 2 -2.01614E-01 1.55365E-01
+ 3 1.92868E-01 1.08395E-01
+ 4 -3.12948E-02 -7.08043E-05
+4 0 *********** SCCC-ala-asn
+ 1 -3.75404E-01 6.51825E-01
+ 2 -3.45384E-01 1.30874E-01
+ 3 2.45000E-01 9.04840E-02
+ 4 -2.17245E-02 -7.23659E-05
+4 0 *********** SCCC-ala-glu
+ 1 -3.43866E-01 5.54211E-01
+ 2 -2.28051E-01 1.66137E-01
+ 3 2.18724E-01 9.82461E-02
+ 4 -3.50013E-02 -1.14697E-03
+4 0 *********** SCCC-ala-asp
+ 1 -3.12738E-01 6.68777E-01
+ 2 -3.05225E-01 1.41344E-01
+ 3 1.92434E-01 9.72087E-02
+ 4 -9.11393E-03 -8.32133E-03
+4 0 *********** SCCC-ala-his
+ 1 -3.76833E-01 6.34999E-01
+ 2 -3.15185E-01 1.55491E-01
+ 3 2.33508E-01 7.55190E-02
+ 4 -2.55150E-02 -1.56111E-03
+4 0 *********** SCCC-ala-arg
+ 1 -3.16390E-01 3.97000E-01
+ 2 -8.43265E-02 1.56751E-01
+ 3 1.90132E-01 1.26901E-01
+ 4 -4.23054E-02 7.02945E-03
+4 0 *********** SCCC-ala-lys
+ 1 -3.22229E-01 3.43068E-01
+ 2 -5.16360E-02 1.65308E-01
+ 3 1.99295E-01 1.28740E-01
+ 4 -4.76730E-02 7.50734E-03
+4 0 *********** SCCC-ala-pro
+ 1 -5.56238E-01 6.96095E-01
+ 2 -5.44022E-01 4.66789E-04
+ 3 3.39968E-01 2.04296E-01
+ 4 -8.56865E-03 7.00255E-02
+4 0 *********** SCCC-gly-cys
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-met
+4 0 *********** SCCC-gly-met
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-phe
+4 0 *********** SCCC-gly-phe
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-ile
+4 0 *********** SCCC-gly-ile
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-leu
+4 0 *********** SCCC-gly-leu
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-val
+4 0 *********** SCCC-gly-val
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-trp
+4 0 *********** SCCC-gly-trp
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-tyr
+4 0 *********** SCCC-gly-tyr
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-ala
+4 0 *********** SCCC-gly-ala
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-gly
+4 0 *********** SCCC-gly-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-thr
+4 0 *********** SCCC-gly-thr
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-ser
+4 0 *********** SCCC-gly-ser
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-gln
+4 0 *********** SCCC-gly-gln
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-asn
+4 0 *********** SCCC-gly-asn
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-glu
+4 0 *********** SCCC-gly-glu
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-asp
+4 0 *********** SCCC-gly-asp
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-his
+4 0 *********** SCCC-gly-his
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-arg
+4 0 *********** SCCC-gly-arg
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-lys
+4 0 *********** SCCC-gly-lys
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-gly-pro
+4 0 *********** SCCC-gly-pro
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCC-thr-cys
- 1 8.32563E-01 8.08879E-01
- 2 3.57328E-01 9.78401E-02
- 3 -3.63137E-01 -9.70564E-03
- 4 2.66765E-01 1.17309E-01
- 5 -4.37874E-01 3.16611E-02
- 6 1.16901E-01 4.67637E-02
-6 0 *********** SCCC-thr-met
- 1 5.98636E-01 6.99714E-01
- 2 3.33001E-01 2.93033E-01
- 3 -4.75809E-01 1.82632E-01
- 4 2.24419E-01 1.68548E-01
- 5 -5.07322E-01 5.23455E-02
- 6 1.03476E-01 3.73493E-02
-6 0 *********** SCCC-thr-phe
- 1 5.88356E-01 7.88856E-01
- 2 2.66394E-01 2.79391E-01
- 3 -4.74637E-01 1.30112E-01
- 4 2.42054E-01 1.54923E-01
- 5 -4.92848E-01 5.25536E-02
- 6 1.05678E-01 4.26401E-02
-6 0 *********** SCCC-thr-ile
- 1 7.05281E-01 5.48646E-01
- 2 4.38507E-01 3.15510E-01
- 3 -4.98788E-01 2.27750E-01
- 4 2.33374E-01 1.75804E-01
- 5 -5.34601E-01 6.37072E-02
- 6 1.07677E-01 3.65862E-02
-6 0 *********** SCCC-thr-leu
- 1 5.86404E-01 7.78484E-01
- 2 2.55581E-01 3.74103E-01
- 3 -5.38578E-01 2.01393E-01
- 4 2.20606E-01 1.65948E-01
- 5 -5.30680E-01 5.31875E-02
- 6 1.00590E-01 3.45381E-02
-6 0 *********** SCCC-thr-val
- 1 6.43916E-01 6.00922E-01
- 2 3.87998E-01 3.60398E-01
- 3 -5.24131E-01 2.36106E-01
- 4 2.33285E-01 1.74430E-01
- 5 -5.51531E-01 6.30644E-02
- 6 1.05033E-01 3.86181E-02
-6 0 *********** SCCC-thr-trp
- 1 5.96859E-01 6.90340E-01
- 2 3.32129E-01 2.02591E-01
- 3 -4.29449E-01 1.03608E-01
- 4 2.61626E-01 1.41779E-01
- 5 -4.68141E-01 4.37905E-02
- 6 1.18551E-01 3.49514E-02
-6 0 *********** SCCC-thr-tyr
- 1 5.83316E-01 7.80132E-01
- 2 2.70011E-01 2.73516E-01
- 3 -4.70458E-01 1.29151E-01
- 4 2.44468E-01 1.54790E-01
- 5 -4.91058E-01 5.21678E-02
- 6 1.06702E-01 4.47762E-02
-6 0 *********** SCCC-thr-ala
- 1 3.97083E-01 6.93290E-01
- 2 2.70774E-01 2.83717E-01
- 3 -4.66583E-01 1.71510E-01
- 4 2.36669E-01 1.50950E-01
- 5 -4.88763E-01 3.86267E-02
- 6 1.08873E-01 3.85994E-02
-6 0 *********** SCCC-thr-gly
- 1 -1.02721E+00 -1.33067E+00
- 2 4.63522E-01 -3.81224E-01
- 3 -5.76703E-01 -1.14932E-01
- 4 3.20096E-01 -1.40888E-01
- 5 -5.62349E-01 -4.72779E-02
- 6 1.30272E-01 -1.29983E-01
-6 0 *********** SCCC-thr-thr
- 1 5.48269E-01 8.35271E-01
- 2 1.54579E-01 3.26590E-01
- 3 -5.77112E-01 7.37547E-02
- 4 2.21575E-01 9.24808E-02
- 5 -4.71171E-01 4.35522E-02
- 6 1.05411E-01 3.62209E-02
-6 0 *********** SCCC-thr-ser
- 1 1.32606E+00 8.98733E-01
- 2 3.98753E-01 8.37870E-02
- 3 -4.00202E-01 -2.03287E-01
- 4 3.92374E-01 -7.12615E-03
- 5 -4.15711E-01 3.72993E-02
- 6 1.28295E-01 5.38160E-02
-6 0 *********** SCCC-thr-gln
- 1 6.85037E-01 6.82197E-01
- 2 4.02586E-01 1.74420E-01
- 3 -3.92886E-01 1.06238E-01
- 4 2.41866E-01 1.46791E-01
- 5 -4.60859E-01 3.95459E-02
- 6 1.13622E-01 4.29170E-02
-6 0 *********** SCCC-thr-asn
- 1 6.57885E-01 8.63875E-01
- 2 3.75405E-01 -6.01477E-02
- 3 -2.04212E-01 -9.19281E-02
- 4 2.58741E-01 9.43649E-02
- 5 -3.65557E-01 -1.76104E-02
- 6 1.21870E-01 2.97593E-02
-6 0 *********** SCCC-thr-glu
- 1 7.75619E-01 7.38694E-01
- 2 3.83901E-01 2.13260E-01
- 3 -4.24967E-01 1.01456E-01
- 4 2.43435E-01 1.45638E-01
- 5 -4.77337E-01 4.62659E-02
- 6 1.10827E-01 3.10636E-02
-6 0 *********** SCCC-thr-asp
- 1 6.23849E-01 1.01012E+00
- 2 1.67001E-01 1.37058E-01
- 3 -3.77943E-01 -2.15966E-02
- 4 2.47393E-01 1.48768E-01
- 5 -4.45190E-01 5.06968E-02
- 6 9.20057E-02 5.77854E-02
-6 0 *********** SCCC-thr-his
- 1 1.00870E+00 8.73694E-01
- 2 4.69437E-01 1.29476E-01
- 3 -3.08284E-01 3.06236E-03
- 4 2.55697E-01 1.03148E-01
- 5 -4.08824E-01 1.28049E-02
- 6 1.16857E-01 5.43271E-02
-6 0 *********** SCCC-thr-arg
- 1 5.58705E-01 7.08321E-01
- 2 3.18998E-01 3.26964E-01
- 3 -4.86797E-01 1.97854E-01
- 4 2.26461E-01 1.65600E-01
- 5 -5.12786E-01 5.03267E-02
- 6 1.02765E-01 3.93492E-02
-6 0 *********** SCCC-thr-lys
- 1 5.26444E-01 7.17485E-01
- 2 3.21766E-01 3.44961E-01
- 3 -4.86557E-01 2.13152E-01
- 4 2.11916E-01 1.71711E-01
- 5 -5.17160E-01 5.24634E-02
- 6 9.62397E-02 4.47782E-02
-6 0 *********** SCCC-thr-pro
- 1 -4.91137E+01 1.05163E+01
- 2 3.95211E+01 -2.26299E+01
- 3 -2.51407E+01 2.52838E+01
- 4 1.27288E+01 -2.25806E+01
- 5 -3.01432E+00 1.27718E+01
- 6 -5.89347E-02 4.71121E+01
-6 0 *********** SCCC-ser-cys
- 1 5.96568E-02 -2.64486E-02
- 2 2.90314E-01 -1.77525E-01
- 3 1.08183E-02 -3.16420E-01
- 4 -3.03842E-01 2.44837E-01
- 5 1.45360E-01 -1.48637E-01
- 6 -1.71990E-01 -3.94255E-01
-6 0 *********** SCCC-ser-met
- 1 3.82460E-02 -6.50637E-04
- 2 1.30530E-01 -9.03176E-02
- 3 -3.07079E-02 -2.20618E-01
- 4 -2.09057E-01 2.45648E-01
- 5 1.08448E-01 -9.65036E-02
- 6 -1.20940E-01 -3.24224E-01
-6 0 *********** SCCC-ser-phe
- 1 3.16874E-02 1.51406E-02
- 2 1.49908E-01 -1.02225E-01
- 3 -1.21842E-02 -2.21147E-01
- 4 -2.15510E-01 2.47439E-01
- 5 1.17487E-01 -1.03605E-01
- 6 -1.24396E-01 -3.29061E-01
-6 0 *********** SCCC-ser-ile
- 1 8.02785E-02 -4.88144E-02
- 2 7.19947E-02 -1.07412E-01
- 3 -6.19658E-02 -2.40820E-01
- 4 -1.90729E-01 2.23428E-01
- 5 8.67548E-02 -8.83213E-02
- 6 -1.12671E-01 -3.16937E-01
-6 0 *********** SCCC-ser-leu
- 1 3.61863E-02 1.15400E-02
- 2 8.20527E-02 -1.02535E-01
- 3 -2.80915E-02 -2.03699E-01
- 4 -1.93852E-01 2.57197E-01
- 5 1.03572E-01 -9.02309E-02
- 6 -1.09038E-01 -3.06033E-01
-6 0 *********** SCCC-ser-val
- 1 6.76412E-02 -2.87681E-02
- 2 5.10756E-02 -9.39284E-02
- 3 -5.22726E-02 -2.22931E-01
- 4 -1.71271E-01 2.19417E-01
- 5 8.62457E-02 -8.65418E-02
- 6 -1.09418E-01 -3.08644E-01
-6 0 *********** SCCC-ser-trp
- 1 3.99646E-02 -8.68878E-04
- 2 1.70158E-01 -1.03379E-01
- 3 -1.51019E-02 -2.36384E-01
- 4 -2.20868E-01 2.37546E-01
- 5 1.19729E-01 -1.07667E-01
- 6 -1.31324E-01 -3.35997E-01
-6 0 *********** SCCC-ser-tyr
- 1 3.14511E-02 1.47403E-02
- 2 1.49614E-01 -1.01222E-01
- 3 -1.25592E-02 -2.20533E-01
- 4 -2.14980E-01 2.47535E-01
- 5 1.17541E-01 -1.03255E-01
- 6 -1.24167E-01 -3.19233E-01
-6 0 *********** SCCC-ser-ala
- 1 1.59316E-03 3.25206E-02
- 2 1.02072E-01 -3.08049E-02
- 3 -3.74334E-02 -1.70457E-01
- 4 -1.86500E-01 2.46005E-01
- 5 9.38317E-02 -8.28787E-02
- 6 -1.10836E-01 -3.06507E-01
-6 0 *********** SCCC-ser-gly
- 1 -6.91339E-01 -3.35750E-01
- 2 3.48382E-01 1.28857E-01
- 3 3.87594E-02 -2.88128E-02
- 4 -4.67894E-02 6.29824E-02
- 5 7.48372E-02 -3.80196E-02
- 6 -8.72946E-02 -1.89737E-01
-6 0 *********** SCCC-ser-thr
- 1 4.00985E-02 2.34336E-02
- 2 1.20183E-01 -1.09421E-01
- 3 -2.72808E-02 -2.17048E-01
- 4 -2.20068E-01 2.04931E-01
- 5 9.42640E-02 -9.75846E-02
- 6 -1.09821E-01 -2.85694E-01
-6 0 *********** SCCC-ser-ser
- 1 1.40588E-01 -7.79212E-02
- 2 2.20739E-01 -3.38745E-01
- 3 1.47935E-02 -3.73264E-01
- 4 -3.28036E-01 2.86341E-01
- 5 1.30602E-01 -1.57721E-01
- 6 -1.54242E-01 -4.10916E-01
-6 0 *********** SCCC-ser-gln
- 1 4.36549E-02 -1.44905E-02
- 2 2.21604E-01 -1.04888E-01
- 3 -1.64046E-02 -2.63291E-01
- 4 -2.47573E-01 2.34899E-01
- 5 1.26273E-01 -1.18725E-01
- 6 -1.47698E-01 -3.55301E-01
-6 0 *********** SCCC-ser-asn
- 1 -1.59205E-02 -4.55770E-03
- 2 4.53040E-01 -6.12706E-02
- 3 2.02264E-02 -3.29615E-01
- 4 -3.37749E-01 2.05347E-01
- 5 1.87789E-01 -1.71679E-01
- 6 -2.24535E-01 -4.28821E-01
-6 0 *********** SCCC-ser-glu
- 1 6.26798E-02 -2.02219E-02
- 2 2.08694E-01 -1.43014E-01
- 3 -8.43012E-03 -2.77504E-01
- 4 -2.49906E-01 2.37234E-01
- 5 1.25206E-01 -1.23453E-01
- 6 -1.45452E-01 -3.64876E-01
-6 0 *********** SCCC-ser-asp
- 1 -2.06605E-03 2.20246E-02
- 2 3.12050E-01 -1.03313E-01
- 3 1.57789E-02 -2.66623E-01
- 4 -2.98573E-01 2.62920E-01
- 5 1.65979E-01 -1.38166E-01
- 6 -1.67273E-01 -3.84371E-01
-6 0 *********** SCCC-ser-his
- 1 6.08383E-02 -3.57776E-02
- 2 3.54080E-01 -1.64782E-01
- 3 1.17786E-02 -3.49443E-01
- 4 -3.33582E-01 2.29328E-01
- 5 1.46423E-01 -1.66063E-01
- 6 -1.93310E-01 -4.16547E-01
-6 0 *********** SCCC-ser-arg
- 1 3.00992E-02 8.83367E-03
- 2 1.06994E-01 -6.99820E-02
- 3 -3.25076E-02 -2.03833E-01
- 4 -1.91898E-01 2.46992E-01
- 5 1.04150E-01 -8.99912E-02
- 6 -1.12257E-01 -3.22987E-01
-6 0 *********** SCCC-ser-lys
- 1 2.12652E-02 1.82776E-02
- 2 1.10454E-01 -4.58432E-02
- 3 -3.63510E-02 -1.93235E-01
- 4 -1.88380E-01 2.35245E-01
- 5 9.60389E-02 -8.79188E-02
- 6 -1.13128E-01 -3.11062E-01
-6 0 *********** SCCC-ser-pro
- 1 -5.17468E+01 1.34634E+01
- 2 4.14445E+01 -2.37927E+01
- 3 -2.70753E+01 2.77597E+01
- 4 1.37519E+01 -2.34356E+01
- 5 -3.50940E+00 1.34343E+01
- 6 1.01337E-01 5.09372E+01
-6 0 *********** SCCC-gln-cys
- 1 6.19920E-01 8.13881E-01
- 2 1.49287E-01 -1.64915E-01
- 3 -5.69623E-02 -9.08789E-02
- 4 1.46020E-02 1.04750E-01
- 5 -1.40402E-01 -4.99878E-02
- 6 2.49452E-02 3.03150E-02
-6 0 *********** SCCC-gln-met
- 1 5.05788E-01 7.24826E-01
- 2 3.66015E-02 9.02199E-02
- 3 -2.36417E-01 2.97539E-02
- 4 2.11385E-02 1.07834E-01
- 5 -1.63119E-01 -9.81862E-03
- 6 2.16788E-02 2.12837E-02
-6 0 *********** SCCC-gln-phe
- 1 4.70961E-01 7.98361E-01
- 2 2.54748E-03 3.76038E-02
- 3 -1.85176E-01 7.79596E-03
- 4 1.89187E-02 1.37878E-01
- 5 -1.74129E-01 -1.37478E-02
- 6 2.25815E-02 1.98994E-02
-6 0 *********** SCCC-gln-ile
- 1 6.28377E-01 6.04000E-01
- 2 6.35174E-02 1.33723E-01
- 3 -2.97090E-01 1.34064E-02
- 4 4.98742E-02 6.90106E-02
- 5 -1.66040E-01 -8.02895E-03
- 6 3.69449E-02 5.56713E-03
-6 0 *********** SCCC-gln-leu
- 1 4.72890E-01 7.79488E-01
- 2 -6.28442E-02 1.03885E-01
- 3 -2.51321E-01 2.08490E-02
- 4 3.39730E-02 1.24225E-01
- 5 -1.76517E-01 -4.80265E-03
- 6 2.23859E-02 1.71108E-02
-6 0 *********** SCCC-gln-val
- 1 5.74721E-01 6.46458E-01
- 2 1.06278E-02 1.57654E-01
- 3 -2.97707E-01 2.43488E-02
- 4 4.86666E-02 8.12344E-02
- 5 -1.80013E-01 -8.52930E-03
- 6 3.68176E-02 4.07321E-03
-6 0 *********** SCCC-gln-trp
- 1 5.13153E-01 7.30318E-01
- 2 7.54208E-02 2.21936E-02
- 3 -1.73995E-01 7.50318E-03
- 4 2.11849E-02 1.20679E-01
- 5 -1.64720E-01 -1.74507E-02
- 6 2.51947E-02 1.72030E-02
-6 0 *********** SCCC-gln-tyr
- 1 4.70921E-01 7.92874E-01
- 2 6.77366E-03 3.82328E-02
- 3 -1.84698E-01 1.05276E-02
- 4 1.88059E-02 1.38061E-01
- 5 -1.73829E-01 -1.36343E-02
- 6 2.25507E-02 1.36583E-02
-6 0 *********** SCCC-gln-ala
- 1 3.69251E-01 7.27444E-01
- 2 6.63929E-03 1.36479E-01
- 3 -2.45551E-01 8.02141E-02
- 4 9.06175E-03 1.28499E-01
- 5 -1.77548E-01 -4.38042E-03
- 6 9.20073E-03 2.85368E-02
-6 0 *********** SCCC-gln-gly
- 1 -7.22745E-01 -1.09045E+00
- 2 5.44142E-01 -2.09872E-01
- 3 -2.18223E-01 -1.29760E-01
- 4 2.46786E-01 -8.85457E-02
- 5 -2.13314E-01 -3.32257E-02
- 6 1.01561E-01 -1.39519E-01
-6 0 *********** SCCC-gln-thr
- 1 4.22293E-01 8.31313E-01
- 2 -8.32731E-02 4.80400E-02
- 3 -2.35615E-01 -6.42757E-02
- 4 2.22581E-02 1.48531E-01
- 5 -2.21094E-01 -2.36333E-02
- 6 3.54847E-02 -2.75290E-02
-6 0 *********** SCCC-gln-ser
- 1 8.69877E-01 8.46565E-01
- 2 7.30682E-02 -3.98258E-01
- 3 4.51137E-02 -3.06602E-01
- 4 5.38263E-02 7.88580E-02
- 5 -2.01244E-01 -1.06450E-01
- 6 3.67810E-02 -1.98634E-02
-6 0 *********** SCCC-gln-gln
- 1 5.67770E-01 7.16574E-01
- 2 1.50798E-01 2.45099E-03
- 3 -1.64339E-01 -5.00639E-03
- 4 1.63129E-02 9.22049E-02
- 5 -1.42578E-01 -2.16609E-02
- 6 2.00936E-02 3.52049E-02
-6 0 *********** SCCC-gln-asn
- 1 4.62889E-01 8.68838E-01
- 2 3.11602E-01 -2.06151E-01
- 3 3.61334E-02 -5.29737E-02
- 4 -1.11575E-02 1.01190E-01
- 5 -9.44999E-02 -5.65185E-02
- 6 3.78825E-03 6.85606E-02
-6 0 *********** SCCC-gln-glu
- 1 6.09398E-01 7.52307E-01
- 2 1.07718E-01 -2.77827E-02
- 3 -1.52611E-01 -4.61129E-02
- 4 3.19422E-02 9.27534E-02
- 5 -1.47599E-01 -2.55141E-02
- 6 2.67408E-02 2.14595E-02
-6 0 *********** SCCC-gln-asp
- 1 3.97986E-01 9.69397E-01
- 2 5.71165E-02 -1.68059E-01
- 3 -2.55939E-02 -3.65483E-02
- 4 -3.84171E-02 1.82735E-01
- 5 -1.69647E-01 -6.00285E-02
- 6 1.51944E-02 2.41515E-02
-6 0 *********** SCCC-gln-his
- 1 6.88039E-01 8.30782E-01
- 2 2.41703E-01 -1.64020E-01
- 3 -3.34982E-02 -1.27367E-01
- 4 5.09587E-02 6.00642E-02
- 5 -9.87080E-02 -4.28469E-02
- 6 1.53293E-02 5.48758E-02
-6 0 *********** SCCC-gln-arg
- 1 4.76559E-01 7.32603E-01
- 2 1.32051E-02 1.26312E-01
- 3 -2.47640E-01 4.30225E-02
- 4 2.92951E-02 1.08682E-01
- 5 -1.69216E-01 -1.01814E-02
- 6 2.00014E-02 1.54620E-02
-6 0 *********** SCCC-gln-lys
- 1 4.47638E-01 7.37720E-01
- 2 1.93114E-02 1.55042E-01
- 3 -2.60444E-01 5.62681E-02
- 4 2.06389E-02 1.10199E-01
- 5 -1.72985E-01 -5.46247E-03
- 6 1.69432E-02 2.26239E-02
-6 0 *********** SCCC-gln-pro
- 1 -4.27841E+01 9.97581E+00
- 2 3.50155E+01 -1.92289E+01
- 3 -2.18771E+01 2.26068E+01
- 4 1.12115E+01 -1.93011E+01
- 5 -2.67923E+00 1.13642E+01
- 6 -1.44351E-01 4.14659E+01
-6 0 *********** SCCC-asn-cys
- 1 7.57387E-01 1.17372E+00
- 2 2.08398E-01 3.61800E-01
- 3 -1.28940E-01 -1.34420E-01
- 4 -3.78568E-01 2.55784E-01
- 5 1.27969E-02 -9.23544E-02
- 6 -2.14845E-01 -2.48316E-01
-6 0 *********** SCCC-asn-met
- 1 6.58423E-01 1.08695E+00
- 2 -1.01501E-02 5.41949E-01
- 3 -3.24950E-01 -6.13778E-03
- 4 -3.78494E-01 2.75292E-01
- 5 -2.17686E-02 -4.45267E-02
- 6 -1.80203E-01 -2.28603E-01
-6 0 *********** SCCC-asn-phe
- 1 6.04183E-01 1.15616E+00
- 2 -2.22415E-02 4.88891E-01
- 3 -2.74865E-01 -1.35301E-02
- 4 -3.89501E-01 2.94722E-01
- 5 -2.66922E-02 -4.88006E-02
- 6 -1.93140E-01 -2.14603E-01
-6 0 *********** SCCC-asn-ile
- 1 8.68767E-01 1.00859E+00
- 2 1.08194E-02 5.96323E-01
- 3 -3.55379E-01 2.69439E-02
- 4 -3.65665E-01 2.69668E-01
- 5 -6.80051E-02 -2.87496E-02
- 6 -1.69257E-01 -2.23131E-01
-6 0 *********** SCCC-asn-leu
- 1 6.39806E-01 1.18521E+00
- 2 -1.47182E-01 5.47256E-01
- 3 -3.79392E-01 -2.05691E-02
- 4 -3.87483E-01 2.62638E-01
- 5 -9.68320E-03 -5.49221E-02
- 6 -1.63309E-01 -2.17459E-01
-6 0 *********** SCCC-asn-val
- 1 8.01419E-01 1.05188E+00
- 2 -6.25009E-02 6.01031E-01
- 3 -3.69780E-01 3.37962E-02
- 4 -3.66816E-01 2.58004E-01
- 5 -6.44692E-02 -4.02186E-02
- 6 -1.67954E-01 -2.15854E-01
-6 0 *********** SCCC-asn-trp
- 1 6.29497E-01 1.04140E+00
- 2 7.64047E-02 4.51765E-01
- 3 -2.25870E-01 -1.59904E-02
- 4 -3.62734E-01 2.90501E-01
- 5 -2.33286E-02 -4.19931E-02
- 6 -1.96059E-01 -2.15681E-01
-6 0 *********** SCCC-asn-tyr
- 1 6.03020E-01 1.14475E+00
- 2 -1.42640E-02 4.87177E-01
- 3 -2.71612E-01 -8.62896E-03
- 4 -3.89546E-01 2.98438E-01
- 5 -2.81881E-02 -4.66818E-02
- 6 -1.94007E-01 -2.18886E-01
-6 0 *********** SCCC-asn-ala
- 1 4.44178E-01 9.82931E-01
- 2 -3.99901E-02 4.87516E-01
- 3 -3.01729E-01 1.18280E-03
- 4 -3.58125E-01 2.98468E-01
- 5 -1.25165E-02 -3.03695E-02
- 6 -1.78807E-01 -2.23879E-01
-6 0 *********** SCCC-asn-gly
- 1 -4.09165E-01 -1.51631E+00
- 2 4.37973E-01 -1.76964E-01
- 3 -2.26521E-01 -1.86394E-01
- 4 2.98630E-02 1.18900E-01
- 5 3.27733E-03 -2.59213E-03
- 6 -1.39487E-02 -3.69516E-01
-6 0 *********** SCCC-asn-thr
- 1 4.96208E-01 1.18979E+00
- 2 -2.28681E-01 3.61901E-01
- 3 -2.94898E-01 -2.11223E-01
- 4 -3.14997E-01 1.24589E-01
- 5 3.17801E-02 -9.16300E-02
- 6 -1.27034E-01 -1.86999E-01
-6 0 *********** SCCC-asn-ser
- 1 1.23481E+00 1.37669E+00
- 2 1.99543E-01 1.94487E-01
- 3 -1.48591E-02 -3.48656E-01
- 4 -2.78271E-01 1.86041E-01
- 5 5.08018E-02 -1.38951E-01
- 6 -1.77798E-01 -2.50169E-01
-6 0 *********** SCCC-asn-gln
- 1 7.05576E-01 1.05754E+00
- 2 1.58314E-01 4.94734E-01
- 3 -2.25017E-01 -3.59773E-02
- 4 -3.65323E-01 2.70171E-01
- 5 -9.78863E-03 -5.55620E-02
- 6 -2.00555E-01 -2.36492E-01
-6 0 *********** SCCC-asn-asn
- 1 4.56341E-01 1.06248E+00
- 2 4.15620E-01 2.75930E-01
- 3 3.50941E-02 -1.79722E-01
- 4 -3.60820E-01 2.53045E-01
- 5 8.30759E-02 -1.28723E-01
- 6 -2.35606E-01 -2.85719E-01
-6 0 *********** SCCC-asn-glu
- 1 7.87120E-01 1.15846E+00
- 2 1.06329E-01 4.95932E-01
- 3 -2.35554E-01 -5.44747E-02
- 4 -3.71067E-01 2.59159E-01
- 5 -1.40937E-02 -6.53582E-02
- 6 -1.96601E-01 -2.27803E-01
-6 0 *********** SCCC-asn-asp
- 1 4.57735E-01 1.29630E+00
- 2 1.08738E-01 3.62424E-01
- 3 -1.16064E-01 -7.77284E-02
- 4 -4.46510E-01 3.50590E-01
- 5 1.34213E-02 -9.38743E-02
- 6 -2.18759E-01 -2.57333E-01
-6 0 *********** SCCC-asn-his
- 1 8.95034E-01 1.28940E+00
- 2 2.81060E-01 4.57974E-01
- 3 -1.06631E-01 -1.77331E-01
- 4 -3.43081E-01 2.33512E-01
- 5 4.07713E-02 -1.01495E-01
- 6 -2.10261E-01 -2.74472E-01
-6 0 *********** SCCC-asn-arg
- 1 6.23023E-01 1.08801E+00
- 2 -5.19791E-02 5.56089E-01
- 3 -3.36815E-01 6.89070E-03
- 4 -3.67225E-01 2.81556E-01
- 5 -1.55243E-02 -3.76958E-02
- 6 -1.69889E-01 -2.21766E-01
-6 0 *********** SCCC-asn-lys
- 1 5.95443E-01 1.09271E+00
- 2 -5.50234E-02 5.88178E-01
- 3 -3.48887E-01 1.39484E-02
- 4 -3.76230E-01 2.72531E-01
- 5 -2.99277E-02 -4.43221E-02
- 6 -1.74704E-01 -2.29840E-01
-6 0 *********** SCCC-asn-pro
- 1 -4.36021E+01 9.31235E+00
- 2 3.61388E+01 -2.08332E+01
- 3 -2.29444E+01 2.28950E+01
- 4 1.11539E+01 -2.03052E+01
- 5 -2.99632E+00 1.12710E+01
- 6 -1.81921E-01 4.34059E+01
-6 0 *********** SCCC-glu-cys
- 1 3.33512E-01 4.66991E-01
- 2 1.59731E-01 -4.01375E-01
- 3 -3.44602E-02 -1.51384E-01
- 4 5.19689E-03 6.91636E-02
- 5 -1.38117E-01 -6.87922E-02
- 6 2.46165E-02 2.36173E-02
-6 0 *********** SCCC-glu-met
- 1 2.56991E-01 4.21078E-01
- 2 4.76280E-02 -1.53929E-01
- 3 -1.55020E-01 -6.06431E-02
- 4 6.80921E-02 8.66971E-02
- 5 -1.32350E-01 -1.54234E-02
- 6 3.03586E-02 1.75688E-02
-6 0 *********** SCCC-glu-phe
- 1 2.35017E-01 4.69454E-01
- 2 3.87623E-02 -1.96182E-01
- 3 -1.12899E-01 -6.76006E-02
- 4 5.66148E-02 1.06752E-01
- 5 -1.36615E-01 -2.78645E-02
- 6 3.59205E-02 1.53178E-02
-6 0 *********** SCCC-glu-ile
- 1 3.39594E-01 3.25064E-01
- 2 3.06237E-02 -1.22277E-01
- 3 -2.24279E-01 -8.99189E-02
- 4 9.20531E-02 5.77965E-02
- 5 -1.54817E-01 -2.89931E-03
- 6 3.39350E-02 5.44686E-03
-6 0 *********** SCCC-glu-leu
- 1 2.34542E-01 4.50329E-01
- 2 -2.42988E-02 -1.42929E-01
- 3 -1.56639E-01 -5.72378E-02
- 4 8.04432E-02 1.06976E-01
- 5 -1.41417E-01 -1.31820E-02
- 6 3.37294E-02 7.81027E-03
-6 0 *********** SCCC-glu-val
- 1 3.04441E-01 3.57569E-01
- 2 -1.82237E-03 -9.72650E-02
- 3 -2.13031E-01 -7.56021E-02
- 4 9.67684E-02 6.88332E-02
- 5 -1.59675E-01 -5.53540E-03
- 6 3.78832E-02 -2.20207E-03
-6 0 *********** SCCC-glu-trp
- 1 2.66542E-01 4.32477E-01
- 2 8.08095E-02 -2.06363E-01
- 3 -1.16454E-01 -7.70560E-02
- 4 5.41125E-02 8.82847E-02
- 5 -1.35835E-01 -3.01160E-02
- 6 3.47368E-02 1.85433E-02
-6 0 *********** SCCC-glu-tyr
- 1 2.35221E-01 4.67152E-01
- 2 4.04274E-02 -1.94587E-01
- 3 -1.13486E-01 -6.62534E-02
- 4 5.69888E-02 1.06227E-01
- 5 -1.36087E-01 -2.76945E-02
- 6 3.58774E-02 1.27312E-02
-6 0 *********** SCCC-glu-ala
- 1 1.69035E-01 4.42803E-01
- 2 2.89655E-02 -7.52938E-02
- 3 -1.63365E-01 -7.44405E-03
- 4 6.54211E-02 1.00646E-01
- 5 -1.29408E-01 -1.14088E-02
- 6 2.27846E-02 1.60999E-02
-6 0 *********** SCCC-glu-gly
- 1 -8.22924E-01 -6.34724E-01
- 2 6.76612E-01 -9.84566E-02
- 3 -1.68396E-01 -1.15440E-01
- 4 2.46173E-01 -4.77953E-02
- 5 -1.51223E-01 -1.97809E-02
- 6 1.04465E-01 -1.11350E-01
-6 0 *********** SCCC-glu-thr
- 1 2.09783E-01 4.78479E-01
- 2 -3.90372E-03 -1.78651E-01
- 3 -1.45133E-01 -1.04531E-01
- 4 4.69095E-02 1.37830E-01
- 5 -1.87970E-01 -3.53152E-02
- 6 4.61696E-02 -4.02489E-02
-6 0 *********** SCCC-glu-ser
- 1 4.98899E-01 4.37018E-01
- 2 6.44045E-02 -6.41362E-01
- 3 6.21033E-03 -3.17047E-01
- 4 -4.79588E-02 5.38711E-02
- 5 -2.56969E-01 -1.43913E-01
- 6 1.99031E-02 -3.10343E-02
-6 0 *********** SCCC-glu-gln
- 1 2.97195E-01 4.17592E-01
- 2 1.41035E-01 -2.37389E-01
- 3 -1.12095E-01 -9.31183E-02
- 4 4.31058E-02 6.44466E-02
- 5 -1.25040E-01 -3.15769E-02
- 6 2.50882E-02 2.66721E-02
-6 0 *********** SCCC-glu-asn
- 1 2.29189E-01 5.21923E-01
- 2 3.46864E-01 -3.90701E-01
- 3 2.45942E-02 -1.02180E-01
- 4 -1.74140E-02 3.97879E-02
- 5 -7.74177E-02 -6.87613E-02
- 6 2.36128E-04 8.19054E-02
-6 0 *********** SCCC-glu-glu
- 1 3.24613E-01 4.28595E-01
- 2 1.08077E-01 -2.77879E-01
- 3 -1.00919E-01 -1.23536E-01
- 4 4.50556E-02 6.94494E-02
- 5 -1.39812E-01 -3.87442E-02
- 6 2.94975E-02 2.38997E-02
-6 0 *********** SCCC-glu-asp
- 1 1.92328E-01 5.62603E-01
- 2 1.54220E-01 -3.59290E-01
- 3 -5.51252E-03 -8.00701E-02
- 4 -1.02797E-02 1.10605E-01
- 5 -1.12974E-01 -6.69321E-02
- 6 2.21348E-02 4.10611E-02
-6 0 *********** SCCC-glu-his
- 1 3.61271E-01 4.62013E-01
- 2 2.39313E-01 -4.17066E-01
- 3 -2.69128E-02 -1.78088E-01
- 4 6.86302E-03 3.31232E-02
- 5 -1.27321E-01 -6.85221E-02
- 6 5.82074E-03 4.29599E-02
-6 0 *********** SCCC-glu-arg
- 1 2.36243E-01 4.27868E-01
- 2 3.00951E-02 -1.15300E-01
- 3 -1.61246E-01 -4.69868E-02
- 4 7.99735E-02 8.78959E-02
- 5 -1.35201E-01 -1.49564E-02
- 6 2.89505E-02 1.16463E-02
-6 0 *********** SCCC-glu-lys
- 1 2.14334E-01 4.32615E-01
- 2 3.99828E-02 -8.56384E-02
- 3 -1.68950E-01 -3.51767E-02
- 4 7.57784E-02 8.95872E-02
- 5 -1.33896E-01 -9.75700E-03
- 6 2.75828E-02 1.12341E-02
-6 0 *********** SCCC-glu-pro
- 1 -6.03395E+01 1.53246E+01
- 2 4.89956E+01 -2.73422E+01
- 3 -3.13918E+01 3.21252E+01
- 4 1.58801E+01 -2.73551E+01
- 5 -4.12205E+00 1.60651E+01
- 6 -1.48054E-01 5.94634E+01
-6 0 *********** SCCC-asp-cys
- 1 1.01398E-01 1.01843E+00
- 2 2.96713E-01 7.77802E-01
- 3 -4.55789E-02 -6.04555E-01
- 4 -4.81945E-01 5.47073E-01
- 5 4.96561E-01 -3.47182E-01
- 6 -3.68281E-01 -1.03058E+00
-6 0 *********** SCCC-asp-met
- 1 8.64902E-02 8.97343E-01
- 2 6.60725E-02 7.60140E-01
- 3 -2.33228E-01 -5.34709E-01
- 4 -4.78839E-01 4.19404E-01
- 5 3.94621E-01 -3.16580E-01
- 6 -3.12523E-01 -9.24131E-01
-6 0 *********** SCCC-asp-phe
- 1 -6.78943E-03 9.44651E-01
- 2 6.92742E-02 7.51693E-01
- 3 -1.95415E-01 -5.85413E-01
- 4 -5.01166E-01 4.72714E-01
- 5 4.34243E-01 -3.37999E-01
- 6 -3.38153E-01 -9.88144E-01
-6 0 *********** SCCC-asp-ile
- 1 3.12614E-01 8.47119E-01
- 2 7.40958E-02 7.84262E-01
- 3 -2.59309E-01 -4.76651E-01
- 4 -4.56980E-01 3.78389E-01
- 5 3.40993E-01 -2.96626E-01
- 6 -2.88272E-01 -8.56722E-01
-6 0 *********** SCCC-asp-leu
- 1 3.55098E-02 9.60300E-01
- 2 -3.88031E-02 7.51152E-01
- 3 -2.69089E-01 -6.01118E-01
- 4 -4.89976E-01 4.13485E-01
- 5 4.25671E-01 -3.39868E-01
- 6 -3.11910E-01 -9.66482E-01
-6 0 *********** SCCC-asp-val
- 1 2.29753E-01 8.63296E-01
- 2 1.01385E-02 7.76378E-01
- 3 -2.79216E-01 -5.06076E-01
- 4 -4.63388E-01 3.78804E-01
- 5 3.67536E-01 -3.11700E-01
- 6 -2.86511E-01 -8.93944E-01
-6 0 *********** SCCC-asp-trp
- 1 5.69106E-02 8.67403E-01
- 2 1.59223E-01 7.45429E-01
- 3 -1.58954E-01 -5.29807E-01
- 4 -4.84359E-01 4.83913E-01
- 5 4.06436E-01 -3.10669E-01
- 6 -3.40126E-01 -9.54656E-01
-6 0 *********** SCCC-asp-tyr
- 1 -5.10236E-03 9.35541E-01
- 2 7.58840E-02 7.50839E-01
- 3 -1.93921E-01 -5.79236E-01
- 4 -5.01772E-01 4.74580E-01
- 5 4.31052E-01 -3.35790E-01
- 6 -3.38679E-01 -9.86093E-01
-6 0 *********** SCCC-asp-ala
- 1 -8.08351E-02 7.94725E-01
- 2 3.70684E-02 7.02856E-01
- 3 -2.29891E-01 -5.20819E-01
- 4 -4.73518E-01 4.32160E-01
- 5 3.84946E-01 -2.99467E-01
- 6 -3.12142E-01 -9.09367E-01
-6 0 *********** SCCC-asp-gly
- 1 -1.65198E-01 -1.51943E+00
- 2 3.27189E-01 1.89363E-02
- 3 -8.58367E-02 -3.34181E-01
- 4 -9.91970E-02 1.41845E-01
- 5 7.61626E-02 -9.77067E-02
- 6 -8.86111E-02 -6.11984E-01
-6 0 *********** SCCC-asp-thr
- 1 -1.12033E-01 9.35801E-01
- 2 -3.89147E-02 6.61969E-01
- 3 -1.48782E-01 -7.27168E-01
- 4 -4.32844E-01 4.58700E-01
- 5 4.62044E-01 -3.32022E-01
- 6 -3.43672E-01 -1.01887E+00
-6 0 *********** SCCC-asp-ser
- 1 3.81392E-01 1.24313E+00
- 2 3.41849E-01 8.26265E-01
- 3 9.29866E-02 -8.18342E-01
- 4 -4.20737E-01 6.50498E-01
- 5 6.27310E-01 -3.96091E-01
- 6 -3.96315E-01 -1.24023E+00
-6 0 *********** SCCC-asp-gln
- 1 1.32284E-01 9.00285E-01
- 2 2.14708E-01 7.79347E-01
- 3 -1.48803E-01 -5.02366E-01
- 4 -4.65926E-01 4.63513E-01
- 5 4.03169E-01 -3.03228E-01
- 6 -3.29913E-01 -9.20420E-01
-6 0 *********** SCCC-asp-asn
- 1 -1.31518E-01 9.31468E-01
- 2 4.59779E-01 7.46661E-01
- 3 5.92646E-02 -5.21946E-01
- 4 -4.53030E-01 5.87231E-01
- 5 5.37192E-01 -3.17063E-01
- 6 -3.68526E-01 -1.00485E+00
-6 0 *********** SCCC-asp-glu
- 1 1.70171E-01 9.85753E-01
- 2 1.80671E-01 7.94937E-01
- 3 -1.48722E-01 -5.49940E-01
- 4 -4.72931E-01 4.71782E-01
- 5 4.29471E-01 -3.23801E-01
- 6 -3.35350E-01 -9.57310E-01
-6 0 *********** SCCC-asp-asp
- 1 -2.45680E-01 1.04072E+00
- 2 2.09688E-01 7.42404E-01
- 3 -5.74763E-02 -7.04516E-01
- 4 -5.51587E-01 5.89004E-01
- 5 5.69082E-01 -4.13143E-01
- 6 -3.89834E-01 -1.15660E+00
-6 0 *********** SCCC-asp-his
- 1 2.28403E-01 1.15853E+00
- 2 3.19682E-01 8.47017E-01
- 3 -2.47299E-02 -5.51595E-01
- 4 -4.27205E-01 5.27373E-01
- 5 4.85977E-01 -3.12781E-01
- 6 -3.44694E-01 -9.72863E-01
-6 0 *********** SCCC-asp-arg
- 1 5.81290E-02 8.90656E-01
- 2 2.63559E-02 7.57680E-01
- 3 -2.49384E-01 -5.31822E-01
- 4 -4.75607E-01 4.15715E-01
- 5 3.92803E-01 -3.12919E-01
- 6 -3.06376E-01 -9.03384E-01
-6 0 *********** SCCC-asp-lys
- 1 3.45183E-02 8.88160E-01
- 2 1.04661E-02 7.67404E-01
- 3 -2.62443E-01 -5.18705E-01
- 4 -4.73298E-01 4.01501E-01
- 5 3.84520E-01 -3.11496E-01
- 6 -2.99554E-01 -9.04348E-01
-6 0 *********** SCCC-asp-pro
- 1 -5.87032E+01 1.37268E+01
- 2 4.84918E+01 -2.75769E+01
- 3 -3.14348E+01 3.13599E+01
- 4 1.56551E+01 -2.75889E+01
- 5 -3.90336E+00 1.57657E+01
- 6 -2.15304E-01 5.73576E+01
-6 0 *********** SCCC-his-cys
- 1 4.26129E-01 1.05254E+00
- 2 1.06591E-01 5.80282E-02
- 3 -9.69817E-02 -1.30659E-01
- 4 -1.57220E-02 5.58248E-02
- 5 -1.00912E-01 -4.78612E-02
- 6 -1.55872E-02 1.15355E-02
-6 0 *********** SCCC-his-met
- 1 3.90240E-01 9.14229E-01
- 2 -4.39902E-02 2.16123E-01
- 3 -2.36615E-01 -8.17604E-02
- 4 -1.03937E-01 7.07957E-02
- 5 -8.79604E-02 -4.01881E-02
- 6 -4.45437E-02 -4.22953E-02
-6 0 *********** SCCC-his-phe
- 1 3.42384E-01 9.84345E-01
- 2 -6.26647E-02 1.68303E-01
- 3 -2.05466E-01 -9.04311E-02
- 4 -9.42496E-02 8.27885E-02
- 5 -1.01060E-01 -3.88787E-02
- 6 -4.23188E-02 -2.61596E-02
-6 0 *********** SCCC-his-ile
- 1 5.51948E-01 8.15879E-01
- 2 -3.24603E-02 2.75203E-01
- 3 -2.48522E-01 -9.63950E-02
- 4 -1.22515E-01 6.59116E-02
- 5 -6.14312E-02 -5.14852E-02
- 6 -5.38528E-02 -9.07396E-02
-6 0 *********** SCCC-his-leu
- 1 3.66037E-01 9.69061E-01
- 2 -1.41041E-01 2.07952E-01
- 3 -2.58212E-01 -1.05945E-01
- 4 -1.08600E-01 7.56909E-02
- 5 -8.50347E-02 -3.86772E-02
- 6 -4.62328E-02 -4.63988E-02
-6 0 *********** SCCC-his-val
- 1 4.99194E-01 8.44327E-01
- 2 -8.87063E-02 2.78190E-01
- 3 -2.59519E-01 -9.28997E-02
- 4 -1.28532E-01 7.26125E-02
- 5 -6.13436E-02 -5.18005E-02
- 6 -5.56577E-02 -8.97205E-02
-6 0 *********** SCCC-his-trp
- 1 3.84661E-01 9.17199E-01
- 2 1.15855E-02 1.71292E-01
- 3 -1.84602E-01 -7.41864E-02
- 4 -9.07639E-02 8.09113E-02
- 5 -9.56377E-02 -3.98505E-02
- 6 -4.26114E-02 -3.02919E-02
-6 0 *********** SCCC-his-tyr
- 1 3.42967E-01 9.77574E-01
- 2 -5.78579E-02 1.69299E-01
- 3 -2.05359E-01 -8.69298E-02
- 4 -9.55979E-02 8.36455E-02
- 5 -1.01229E-01 -3.89276E-02
- 6 -4.23963E-02 -2.67324E-02
-6 0 *********** SCCC-his-ala
- 1 2.53050E-01 8.64863E-01
- 2 -7.16073E-02 2.20693E-01
- 3 -2.54647E-01 -4.72402E-02
- 4 -1.18961E-01 8.84736E-02
- 5 -9.61349E-02 -3.48066E-02
- 6 -4.62511E-02 -4.54801E-02
-6 0 *********** SCCC-his-gly
- 1 -2.66886E-01 -1.24960E+00
- 2 3.78467E-01 -8.13890E-02
- 3 -9.73528E-02 -2.68074E-01
- 4 -3.27788E-02 5.12697E-02
- 5 -4.43474E-03 -7.16114E-02
- 6 -5.29240E-02 -4.11709E-01
-6 0 *********** SCCC-his-thr
- 1 3.03006E-01 9.96978E-01
- 2 -1.71501E-01 1.47903E-01
- 3 -1.80822E-01 -1.91221E-01
- 4 -9.22776E-02 7.26861E-02
- 5 -7.27722E-02 -4.24418E-02
- 6 -5.89019E-02 -6.61935E-02
-6 0 *********** SCCC-his-ser
- 1 6.53637E-01 1.19984E+00
- 2 1.66168E-02 -6.22641E-02
- 3 -1.08329E-02 -3.02487E-01
- 4 6.24382E-02 4.28881E-02
- 5 -9.14373E-02 -4.65228E-02
- 6 -1.92292E-02 3.36503E-03
-6 0 *********** SCCC-his-gln
- 1 4.19198E-01 9.21543E-01
- 2 7.86171E-02 1.75810E-01
- 3 -1.74106E-01 -7.84628E-02
- 4 -6.65013E-02 6.09945E-02
- 5 -9.00536E-02 -4.05240E-02
- 6 -3.41653E-02 -2.03566E-02
-6 0 *********** SCCC-his-asn
- 1 2.01316E-01 1.04213E+00
- 2 2.84094E-01 3.14468E-02
- 3 -4.46043E-02 -4.81519E-02
- 4 2.98118E-02 6.87913E-02
- 5 -1.09795E-01 -4.08500E-02
- 6 1.34180E-02 5.75471E-02
-6 0 *********** SCCC-his-glu
- 1 4.61317E-01 9.82251E-01
- 2 3.64251E-02 1.54663E-01
- 3 -1.61095E-01 -1.13872E-01
- 4 -5.61697E-02 5.88642E-02
- 5 -8.55417E-02 -4.25759E-02
- 6 -3.42847E-02 -2.46142E-02
-6 0 *********** SCCC-his-asp
- 1 1.92782E-01 1.14634E+00
- 2 4.09709E-02 1.62176E-02
- 3 -1.09297E-01 -1.00603E-01
- 4 -3.70310E-02 9.06706E-02
- 5 -1.44374E-01 -5.18442E-02
- 6 -4.40291E-03 2.88404E-02
-6 0 *********** SCCC-his-his
- 1 4.50166E-01 1.10493E+00
- 2 1.54484E-01 7.75369E-02
- 3 -6.69497E-02 -1.52702E-01
- 4 4.25305E-02 4.50278E-02
- 5 -7.72572E-02 -3.42156E-02
- 6 -4.13087E-03 2.05909E-02
-6 0 *********** SCCC-his-arg
- 1 3.66429E-01 9.10027E-01
- 2 -7.58621E-02 2.35845E-01
- 3 -2.48634E-01 -7.41660E-02
- 4 -1.10138E-01 7.88516E-02
- 5 -8.24854E-02 -3.84730E-02
- 6 -4.56445E-02 -4.91189E-02
-6 0 *********** SCCC-his-lys
- 1 3.36164E-01 9.03706E-01
- 2 -7.88277E-02 2.55694E-01
- 3 -2.56257E-01 -6.70004E-02
- 4 -1.15889E-01 7.82520E-02
- 5 -8.53364E-02 -3.89155E-02
- 6 -4.83454E-02 -5.72482E-02
-6 0 *********** SCCC-his-pro
- 1 -5.46443E+00 -1.47564E+00
- 2 6.52671E+00 7.04314E-02
- 3 -4.97142E+00 -3.16609E-01
- 4 5.19594E+00 -3.65501E-03
- 5 -4.84378E+00 -8.14439E-02
- 6 2.50003E+00 -4.59432E-01
-6 0 *********** SCCC-arg-cys
- 1 -2.25457E-01 5.67972E-01
- 2 3.42882E-01 2.61249E-01
- 3 1.46928E-01 -6.26437E-01
- 4 -3.62334E-01 4.74250E-01
- 5 4.61470E-01 -3.01303E-01
- 6 -3.16685E-01 -8.88472E-01
-6 0 *********** SCCC-arg-met
- 1 -1.24118E-01 5.29801E-01
- 2 1.28743E-01 3.16688E-01
- 3 -1.83513E-02 -5.14423E-01
- 4 -3.22792E-01 3.96598E-01
- 5 3.20530E-01 -2.12375E-01
- 6 -2.77398E-01 -7.12452E-01
-6 0 *********** SCCC-arg-phe
- 1 -1.84054E-01 5.68944E-01
- 2 1.40271E-01 2.85097E-01
- 3 1.67048E-02 -5.15989E-01
- 4 -3.44075E-01 4.19413E-01
- 5 3.35360E-01 -2.30276E-01
- 6 -2.82041E-01 -7.19142E-01
-6 0 *********** SCCC-arg-ile
- 1 1.55346E-02 4.71838E-01
- 2 1.01262E-01 3.43326E-01
- 3 -4.64782E-02 -5.48703E-01
- 4 -2.97131E-01 3.78357E-01
- 5 3.10700E-01 -2.05767E-01
- 6 -2.74514E-01 -7.42689E-01
-6 0 *********** SCCC-arg-leu
- 1 -1.40090E-01 5.67735E-01
- 2 5.82977E-02 2.83795E-01
- 3 -2.77983E-02 -5.16684E-01
- 4 -3.30435E-01 4.04163E-01
- 5 3.04039E-01 -2.08328E-01
- 6 -2.74806E-01 -7.01813E-01
-6 0 *********** SCCC-arg-val
- 1 -2.14751E-02 4.94226E-01
- 2 6.06540E-02 3.41011E-01
- 3 -5.59566E-02 -5.30383E-01
- 4 -3.05072E-01 3.87245E-01
- 5 3.06080E-01 -2.04132E-01
- 6 -2.71571E-01 -7.32951E-01
-6 0 *********** SCCC-arg-trp
- 1 -1.53752E-01 5.26041E-01
- 2 1.89677E-01 3.11777E-01
- 3 2.06427E-02 -5.25678E-01
- 4 -3.37160E-01 4.17728E-01
- 5 3.54707E-01 -2.35608E-01
- 6 -2.85561E-01 -7.59638E-01
-6 0 *********** SCCC-arg-tyr
- 1 -1.82462E-01 5.65355E-01
- 2 1.42110E-01 2.87551E-01
- 3 1.48546E-02 -5.14617E-01
- 4 -3.44050E-01 4.18743E-01
- 5 3.35568E-01 -2.29759E-01
- 6 -2.82126E-01 -7.35547E-01
-6 0 *********** SCCC-arg-ala
- 1 -1.74358E-01 5.22331E-01
- 2 7.81634E-02 3.27369E-01
- 3 -6.62612E-02 -4.33995E-01
- 4 -3.22963E-01 3.69254E-01
- 5 2.76934E-01 -1.86144E-01
- 6 -2.58222E-01 -6.38771E-01
-6 0 *********** SCCC-arg-gly
- 1 -2.82779E-01 -9.15168E-01
- 2 5.31762E-01 1.58568E-01
- 3 2.00000E-02 -2.43011E-01
- 4 2.06969E-02 9.98012E-02
- 5 7.49582E-02 -6.84532E-02
- 6 -2.79170E-02 -4.53229E-01
-6 0 *********** SCCC-arg-thr
- 1 -1.84418E-01 5.95126E-01
- 2 6.77534E-02 2.42319E-01
- 3 3.57926E-02 -5.26318E-01
- 4 -3.32711E-01 4.05580E-01
- 5 2.88171E-01 -2.37246E-01
- 6 -2.63058E-01 -7.22033E-01
-6 0 *********** SCCC-arg-ser
- 1 -2.41180E-01 5.89876E-01
- 2 3.60799E-01 1.83892E-01
- 3 2.70668E-01 -8.94535E-01
- 4 -4.59965E-01 6.30017E-01
- 5 5.48395E-01 -4.54071E-01
- 6 -3.73720E-01 -1.20895E+00
-6 0 *********** SCCC-arg-gln
- 1 -1.43252E-01 5.16458E-01
- 2 2.50493E-01 3.25862E-01
- 3 4.27416E-02 -5.43829E-01
- 4 -3.22353E-01 4.14656E-01
- 5 3.77999E-01 -2.39455E-01
- 6 -2.88794E-01 -7.81924E-01
-6 0 *********** SCCC-arg-asn
- 1 -3.75961E-01 5.63067E-01
- 2 4.97401E-01 3.18238E-01
- 3 1.77799E-01 -5.16703E-01
- 4 -3.45707E-01 4.62013E-01
- 5 5.20409E-01 -2.77766E-01
- 6 -3.09191E-01 -8.09121E-01
-6 0 *********** SCCC-arg-glu
- 1 -1.43203E-01 5.43960E-01
- 2 2.38763E-01 2.96997E-01
- 3 7.07663E-02 -5.86704E-01
- 4 -3.32321E-01 4.38538E-01
- 5 3.94225E-01 -2.58363E-01
- 6 -2.97135E-01 -8.12682E-01
-6 0 *********** SCCC-arg-asp
- 1 -3.50193E-01 6.43602E-01
- 2 2.98857E-01 2.09804E-01
- 3 1.31500E-01 -5.08409E-01
- 4 -3.81928E-01 4.39909E-01
- 5 4.11013E-01 -2.70170E-01
- 6 -2.97422E-01 -7.44492E-01
-6 0 *********** SCCC-arg-his
- 1 -2.32389E-01 5.78747E-01
- 2 4.01715E-01 2.84016E-01
- 3 1.86732E-01 -6.38404E-01
- 4 -3.35151E-01 4.85710E-01
- 5 4.91499E-01 -3.03397E-01
- 6 -3.12691E-01 -8.88012E-01
-6 0 *********** SCCC-arg-arg
- 1 -1.29656E-01 5.32369E-01
- 2 9.49252E-02 3.26845E-01
- 3 -3.69210E-02 -4.95022E-01
- 4 -3.19943E-01 3.94507E-01
- 5 3.08362E-01 -2.02564E-01
- 6 -2.71706E-01 -7.01639E-01
-6 0 *********** SCCC-arg-lys
- 1 -1.39161E-01 5.32424E-01
- 2 8.57496E-02 3.41146E-01
- 3 -4.81295E-02 -4.70281E-01
- 4 -3.15563E-01 3.83893E-01
- 5 2.91910E-01 -1.93891E-01
- 6 -2.65753E-01 -6.74302E-01
-6 0 *********** SCCC-arg-pro
- 1 -2.08968E+01 -7.11420E-01
- 2 1.64941E+01 4.30835E-01
- 3 -7.34251E+00 5.49948E-01
- 4 2.86843E-04 -2.10932E-02
- 5 5.62115E+00 3.21222E-01
- 6 -3.95025E+00 1.70430E-01
-6 0 *********** SCCC-lys-cys
- 1 -5.42720E-01 3.12999E-01
- 2 3.68442E-01 1.38047E-01
- 3 1.60306E-01 -7.10412E-01
- 4 -3.42653E-01 4.52025E-01
- 5 4.66251E-01 -2.99678E-01
- 6 -3.31138E-01 -9.08035E-01
-6 0 *********** SCCC-lys-met
- 1 -3.89792E-01 2.79118E-01
- 2 1.80705E-01 1.97709E-01
- 3 1.92015E-02 -6.10719E-01
- 4 -2.95412E-01 3.84344E-01
- 5 3.47854E-01 -2.18423E-01
- 6 -2.89281E-01 -7.72021E-01
-6 0 *********** SCCC-lys-phe
- 1 -4.68655E-01 2.79610E-01
- 2 2.25775E-01 2.07030E-01
- 3 4.06352E-02 -6.42198E-01
- 4 -3.29870E-01 4.23752E-01
- 5 3.95701E-01 -2.49825E-01
- 6 -3.11593E-01 -8.46987E-01
-6 0 *********** SCCC-lys-ile
- 1 -2.47983E-01 2.83280E-01
- 2 9.54783E-02 1.69539E-01
- 3 -3.72299E-03 -5.99401E-01
- 4 -2.67261E-01 3.46269E-01
- 5 2.93146E-01 -1.95308E-01
- 6 -2.69224E-01 -6.94742E-01
-6 0 *********** SCCC-lys-leu
- 1 -4.06469E-01 2.86851E-01
- 2 1.45336E-01 1.98590E-01
- 3 -1.83581E-03 -6.37613E-01
- 4 -3.15501E-01 4.01855E-01
- 5 3.59173E-01 -2.23985E-01
- 6 -3.03819E-01 -7.92088E-01
-6 0 *********** SCCC-lys-val
- 1 -2.78646E-01 2.80852E-01
- 2 8.58492E-02 1.87851E-01
- 3 -1.75277E-02 -5.92547E-01
- 4 -2.85639E-01 3.63589E-01
- 5 3.08732E-01 -2.05794E-01
- 6 -2.72583E-01 -7.25760E-01
-6 0 *********** SCCC-lys-trp
- 1 -4.33202E-01 2.74302E-01
- 2 2.37621E-01 1.98114E-01
- 3 4.97520E-02 -6.23541E-01
- 4 -3.13508E-01 4.05198E-01
- 5 3.84083E-01 -2.44089E-01
- 6 -2.98660E-01 -8.13969E-01
-6 0 *********** SCCC-lys-tyr
- 1 -4.66366E-01 2.78189E-01
- 2 2.25655E-01 2.08088E-01
- 3 3.91325E-02 -6.40535E-01
- 4 -3.28849E-01 4.22309E-01
- 5 3.94782E-01 -2.48695E-01
- 6 -3.11008E-01 -8.30544E-01
-6 0 *********** SCCC-lys-ala
- 1 -4.23171E-01 2.43232E-01
- 2 1.63525E-01 2.59023E-01
- 3 -2.95240E-02 -5.69759E-01
- 4 -2.99258E-01 3.84530E-01
- 5 3.37869E-01 -2.03933E-01
- 6 -2.85762E-01 -7.66860E-01
-6 0 *********** SCCC-lys-gly
- 1 -2.61171E-01 -5.08968E-01
- 2 6.39254E-01 2.38609E-01
- 3 -1.22228E-03 -1.85240E-01
- 4 3.65466E-02 1.17449E-01
- 5 3.58733E-02 -3.59188E-02
- 6 -5.65221E-03 -3.72145E-01
-6 0 *********** SCCC-lys-thr
- 1 -4.60898E-01 2.91872E-01
- 2 1.82050E-01 1.90419E-01
- 3 6.37789E-02 -6.39614E-01
- 4 -3.37333E-01 4.33803E-01
- 5 3.60259E-01 -2.56430E-01
- 6 -3.14000E-01 -8.55935E-01
-6 0 *********** SCCC-lys-ser
- 1 -5.60991E-01 3.64126E-01
- 2 3.39685E-01 3.15454E-02
- 3 2.13973E-01 -9.20063E-01
- 4 -4.38578E-01 5.22642E-01
- 5 5.07183E-01 -3.96482E-01
- 6 -3.98286E-01 -1.09478E+00
-6 0 *********** SCCC-lys-gln
- 1 -4.23898E-01 2.82983E-01
- 2 2.70250E-01 1.81391E-01
- 3 7.92010E-02 -6.15073E-01
- 4 -2.90111E-01 3.90694E-01
- 5 3.77395E-01 -2.37630E-01
- 6 -2.87336E-01 -7.78800E-01
-6 0 *********** SCCC-lys-asn
- 1 -6.85236E-01 2.74181E-01
- 2 5.37122E-01 2.25619E-01
- 3 2.08574E-01 -6.16476E-01
- 4 -3.23743E-01 4.75809E-01
- 5 5.29305E-01 -2.97807E-01
- 6 -3.13426E-01 -9.02178E-01
-6 0 *********** SCCC-lys-glu
- 1 -4.33894E-01 3.05107E-01
- 2 2.62490E-01 1.51528E-01
- 3 9.64930E-02 -6.52116E-01
- 4 -3.10245E-01 4.08217E-01
- 5 3.92892E-01 -2.57230E-01
- 6 -2.99949E-01 -7.94285E-01
-6 0 *********** SCCC-lys-asp
- 1 -7.29156E-01 2.57351E-01
- 2 4.51858E-01 2.59511E-01
- 3 1.41673E-01 -7.51786E-01
- 4 -3.99817E-01 5.34306E-01
- 5 5.66692E-01 -3.27218E-01
- 6 -3.87000E-01 -1.04673E+00
-6 0 *********** SCCC-lys-his
- 1 -5.33792E-01 3.39798E-01
- 2 3.93177E-01 1.11429E-01
- 3 2.02530E-01 -6.68503E-01
- 4 -3.07473E-01 4.32888E-01
- 5 4.43312E-01 -2.83785E-01
- 6 -3.05073E-01 -8.43564E-01
-6 0 *********** SCCC-lys-arg
- 1 -3.86581E-01 2.72758E-01
- 2 1.58151E-01 2.15924E-01
- 3 -2.21757E-03 -5.95358E-01
- 4 -2.94550E-01 3.82756E-01
- 5 3.43477E-01 -2.08764E-01
- 6 -2.87826E-01 -7.55516E-01
-6 0 *********** SCCC-lys-lys
- 1 -3.92038E-01 2.64193E-01
- 2 1.56184E-01 2.35412E-01
- 3 -7.34176E-03 -5.72639E-01
- 4 -2.91507E-01 3.81741E-01
- 5 3.31098E-01 -2.05458E-01
- 6 -2.80892E-01 -7.51249E-01
-6 0 *********** SCCC-lys-pro
- 1 -2.91173E+01 7.01501E+00
- 2 2.44183E+01 -1.28436E+01
- 3 -1.52367E+01 1.52397E+01
- 4 7.35246E+00 -1.35950E+01
- 5 -2.07135E+00 7.67088E+00
- 6 -3.80734E-01 2.84745E+01
-6 0 *********** SCCC-pro-cys
- 1 -1.67732E+00 -1.88290E+00
- 2 5.04230E-02 4.44126E-01
- 3 2.69948E-01 -7.68592E-01
- 4 -3.71141E-01 5.35451E-01
- 5 4.41385E-01 -4.00571E-01
- 6 -3.21157E-01 -1.53964E+00
-6 0 *********** SCCC-pro-met
- 1 -1.37356E+00 -1.97801E+00
- 2 -2.80114E-01 5.99548E-01
- 3 1.04133E-01 -6.65641E-01
- 4 -2.18489E-01 5.71603E-01
- 5 4.73404E-01 -4.07078E-01
- 6 -3.85237E-01 -1.58381E+00
-6 0 *********** SCCC-pro-phe
- 1 -1.34069E+00 -1.96169E+00
- 2 -1.84307E-01 5.85846E-01
- 3 1.56691E-01 -7.60590E-01
- 4 -2.96895E-01 5.18536E-01
- 5 4.41350E-01 -3.78271E-01
- 6 -3.64750E-01 -1.56830E+00
-6 0 *********** SCCC-pro-ile
- 1 -1.56778E+00 -2.11190E+00
- 2 -4.70335E-01 6.60598E-01
- 3 8.18942E-02 -5.51189E-01
- 4 -1.60381E-01 5.96065E-01
- 5 4.59210E-01 -4.61075E-01
- 6 -4.15776E-01 -1.64600E+00
-6 0 *********** SCCC-pro-leu
- 1 -1.22353E+00 -2.08215E+00
- 2 -4.14520E-01 5.15048E-01
- 3 3.21619E-02 -6.61637E-01
- 4 -1.81700E-01 5.82300E-01
- 5 4.71747E-01 -4.32947E-01
- 6 -4.18487E-01 -1.60776E+00
-6 0 *********** SCCC-pro-val
- 1 -1.43641E+00 -2.12344E+00
- 2 -5.01202E-01 6.34031E-01
- 3 5.15234E-02 -5.52367E-01
- 4 -1.65833E-01 5.88697E-01
- 5 4.64253E-01 -4.72521E-01
- 6 -4.20447E-01 -1.64086E+00
-6 0 *********** SCCC-pro-trp
- 1 -1.46741E+00 -1.82010E+00
- 2 -6.19586E-02 6.25770E-01
- 3 1.78044E-01 -7.85048E-01
- 4 -3.35361E-01 5.24906E-01
- 5 4.46837E-01 -3.45456E-01
- 6 -3.35359E-01 -1.55832E+00
-6 0 *********** SCCC-pro-tyr
- 1 -1.35100E+00 -1.95249E+00
- 2 -1.76243E-01 5.99418E-01
- 3 1.63870E-01 -7.65471E-01
- 4 -2.98811E-01 5.14151E-01
- 5 4.39580E-01 -3.73949E-01
- 6 -3.62622E-01 -1.56735E+00
-6 0 *********** SCCC-pro-ala
- 1 -1.17650E+00 -1.73164E+00
- 2 -1.37735E-01 6.31757E-01
- 3 9.84337E-02 -7.84943E-01
- 4 -2.81918E-01 5.47824E-01
- 5 4.73760E-01 -3.23515E-01
- 6 -3.59031E-01 -1.52796E+00
-6 0 *********** SCCC-pro-gly
- 1 -1.04162E+00 1.18134E+00
- 2 4.68550E-01 8.23358E-01
- 3 -9.21165E-02 -5.98772E-01
- 4 -8.89726E-02 4.77407E-01
- 5 2.59409E-01 -1.46359E-02
- 6 -2.44069E-01 -7.12548E-01
-6 0 *********** SCCC-pro-thr
- 1 -9.65987E-01 -1.76950E+00
- 2 -2.35867E-01 1.59760E-01
- 3 -9.05434E-02 -6.83679E-01
- 4 -3.24679E-01 6.81381E-01
- 5 4.56582E-01 -4.18455E-01
- 6 -3.92698E-01 -1.49977E+00
-6 0 *********** SCCC-pro-ser
- 1 -2.10042E+00 -1.93474E+00
- 2 1.18785E-01 -1.10217E-02
- 3 1.55161E-01 -8.27855E-01
- 4 -4.73521E-01 5.06755E-01
- 5 3.36582E-01 -4.55938E-01
- 6 -3.44135E-01 -1.45545E+00
-6 0 *********** SCCC-pro-gln
- 1 -1.58591E+00 -1.91004E+00
- 2 -8.49389E-02 6.14066E-01
- 3 1.96943E-01 -6.81036E-01
- 4 -2.80559E-01 5.50499E-01
- 5 4.69871E-01 -3.96173E-01
- 6 -3.47409E-01 -1.56811E+00
-6 0 *********** SCCC-pro-asn
- 1 -1.59213E+00 -1.64717E+00
- 2 4.24801E-01 4.32002E-01
- 3 3.61758E-01 -7.78850E-01
- 4 -4.24629E-01 5.04511E-01
- 5 4.61223E-01 -3.73766E-01
- 6 -2.73411E-01 -1.47307E+00
-6 0 *********** SCCC-pro-glu
- 1 -1.60854E+00 -2.03208E+00
- 2 -1.60715E-01 5.49578E-01
- 3 1.74180E-01 -6.71794E-01
- 4 -2.80768E-01 5.53145E-01
- 5 4.58059E-01 -4.22328E-01
- 6 -3.61176E-01 -1.60459E+00
-6 0 *********** SCCC-pro-asp
- 1 -1.32840E+00 -2.00553E+00
- 2 3.28393E-02 5.12413E-01
- 3 3.93885E-01 -8.35558E-01
- 4 -4.26656E-01 3.64434E-01
- 5 4.24414E-01 -3.10258E-01
- 6 -3.41923E-01 -1.41921E+00
-6 0 *********** SCCC-pro-his
- 1 -1.94718E+00 -2.15304E+00
- 2 9.76240E-02 4.80223E-01
- 3 2.49290E-01 -7.27307E-01
- 4 -3.80464E-01 5.61481E-01
- 5 4.35333E-01 -3.80314E-01
- 6 -2.96993E-01 -1.58028E+00
-6 0 *********** SCCC-pro-arg
- 1 -1.30907E+00 -1.96321E+00
- 2 -2.81577E-01 6.05268E-01
- 3 6.47645E-02 -6.87110E-01
- 4 -2.26167E-01 5.64475E-01
- 5 4.80269E-01 -3.73378E-01
- 6 -3.89758E-01 -1.54774E+00
-6 0 *********** SCCC-pro-lys
- 1 -1.28039E+00 -2.02427E+00
- 2 -3.27808E-01 6.30072E-01
- 3 7.22401E-02 -6.32455E-01
- 4 -1.91723E-01 5.76167E-01
- 5 4.73378E-01 -4.23485E-01
- 6 -3.99281E-01 -1.59757E+00
-6 0 *********** SCCC-pro-pro
- 1 -2.18431E+01 3.85091E+01
- 2 1.68382E+01 2.79941E+01
- 3 1.68049E+01 -6.75771E-01
- 4 -3.33389E-02 -1.11280E+00
- 5 5.03821E+00 9.40226E+00
- 6 7.45544E+00 5.53280E+00
-6 0 *********** CCCS-cys-cys
- 1 -9.81745E-02 1.05860E-01
- 2 -1.54034E-01 4.57802E-01
- 3 -1.62409E-01 -4.95721E-02
- 4 -1.63960E-01 1.76700E-01
- 5 2.11840E-02 -8.95466E-02
- 6 -1.29535E-01 -3.54785E-01
-6 0 *********** CCCS-cys-met
- 1 -1.61382E-01 4.41823E-02
- 2 2.04047E-01 2.36528E-01
- 3 -8.42628E-02 -3.79565E-02
- 4 -1.35987E-02 7.32780E-02
- 5 -6.18599E-02 -1.98650E-02
- 6 -2.57727E-02 -1.58606E-01
-6 0 *********** CCCS-cys-phe
- 1 -1.70407E-01 5.66838E-02
- 2 3.11945E-01 1.24446E-01
- 3 -1.13676E-01 -6.09070E-02
- 4 2.63575E-03 3.55910E-02
- 5 -7.76774E-02 -2.80114E-02
- 6 -1.51044E-02 -1.08868E-01
-6 0 *********** CCCS-cys-ile
- 1 -1.96794E-01 7.21041E-02
- 2 3.01761E-01 2.06343E-01
- 3 -1.60990E-01 2.24058E-02
- 4 1.35673E-01 4.06216E-02
- 5 -1.92407E-01 1.06326E-02
- 6 5.59099E-02 -5.83858E-02
-6 0 *********** CCCS-cys-leu
- 1 -1.94629E-01 2.08782E-02
- 2 4.63980E-01 1.48911E-01
- 3 -4.12062E-02 -7.83901E-02
- 4 4.50108E-02 4.53411E-02
- 5 -1.56283E-02 -2.98441E-02
- 6 -5.31545E-03 -1.35551E-01
-6 0 *********** CCCS-cys-val
- 1 -1.58667E-01 5.07564E-02
- 2 2.80077E-01 1.69397E-01
- 3 -7.46638E-02 -2.62789E-02
- 4 3.07309E-02 7.06392E-02
- 5 -7.07689E-02 -1.24936E-02
- 6 -6.84213E-03 -1.20979E-01
-6 0 *********** CCCS-cys-trp
- 1 -1.70350E-01 6.23057E-02
- 2 2.90370E-01 1.53125E-01
- 3 -1.36668E-01 -3.18448E-02
- 4 3.70789E-02 3.32821E-02
- 5 -1.18722E-01 -1.59826E-02
- 6 5.39639E-03 -9.53532E-02
-6 0 *********** CCCS-cys-tyr
- 1 -1.63243E-01 5.21610E-02
- 2 2.86898E-01 1.29025E-01
- 3 -1.03150E-01 -7.23908E-02
- 4 -2.22920E-02 4.55200E-02
- 5 -5.64695E-02 -3.42481E-02
- 6 -3.00337E-02 -1.28343E-01
-6 0 *********** CCCS-cys-ala
- 1 -1.82384E-01 -1.97317E-02
- 2 1.50788E-01 4.42957E-01
- 3 -3.60925E-02 1.10769E-02
- 4 -5.10233E-02 1.29235E-01
- 5 -4.75376E-02 -1.00092E-02
- 6 -5.57854E-02 -2.39740E-01
-6 0 *********** CCCS-cys-gly
+4 0 *********** SCCC-thr-cys
+ 1 -4.90024E-01 4.99375E-01
+ 2 -2.61455E-01 3.68842E-01
+ 3 1.46841E-01 -4.96766E-02
+ 4 -6.38052E-02 9.61894E-03
+4 0 *********** SCCC-thr-met
+ 1 -4.61647E-01 3.24030E-01
+ 2 -5.21712E-02 3.12550E-01
+ 3 1.12628E-01 1.92250E-02
+ 4 -7.86351E-02 3.52093E-02
+4 0 *********** SCCC-thr-phe
+ 1 -5.02279E-01 2.89948E-01
+ 2 -8.82445E-02 3.22638E-01
+ 3 1.43670E-01 1.65575E-02
+ 4 -8.61400E-02 2.09730E-02
+4 0 *********** SCCC-thr-ile
+ 1 -4.39048E-01 4.23823E-01
+ 2 -7.03309E-02 3.37190E-01
+ 3 8.91131E-02 -1.89793E-02
+ 4 -7.23148E-02 4.60728E-02
+4 0 *********** SCCC-thr-leu
+ 1 -4.82373E-01 2.57188E-01
+ 2 -2.08155E-02 3.29115E-01
+ 3 1.30920E-01 1.96853E-02
+ 4 -8.86284E-02 3.57762E-02
+4 0 *********** SCCC-thr-val
+ 1 -4.50873E-01 3.61471E-01
+ 2 -4.26064E-02 3.28680E-01
+ 3 1.00254E-01 -8.35167E-04
+ 4 -7.82746E-02 4.47010E-02
+4 0 *********** SCCC-thr-trp
+ 1 -4.86353E-01 3.59613E-01
+ 2 -1.21384E-01 3.08268E-01
+ 3 1.26119E-01 7.29395E-03
+ 4 -7.52840E-02 2.30441E-02
+4 0 *********** SCCC-thr-tyr
+ 1 -4.97418E-01 2.92414E-01
+ 2 -8.32210E-02 3.22340E-01
+ 3 1.40823E-01 1.72882E-02
+ 4 -8.55928E-02 2.26879E-02
+4 0 *********** SCCC-thr-ala
+ 1 -4.54346E-01 2.04123E-01
+ 2 2.90041E-02 2.84000E-01
+ 3 1.20336E-01 4.83944E-02
+ 4 -7.64249E-02 3.42573E-02
+4 0 *********** SCCC-thr-gly
+ 1 7.28446E-01 3.43991E-01
+ 2 1.15445E-01 -5.45032E-01
+ 3 2.09564E-01 -1.56868E-02
+ 4 -2.74504E-02 5.70935E-02
+4 0 *********** SCCC-thr-thr
+ 1 -4.38661E-01 3.94990E-01
+ 2 -1.41118E-01 2.56087E-01
+ 3 9.83967E-02 2.83491E-02
+ 4 -5.71865E-02 1.25208E-02
+4 0 *********** SCCC-thr-ser
+ 1 -5.14363E-01 6.01150E-01
+ 2 -3.83309E-01 4.28468E-01
+ 3 1.70922E-01 -1.32749E-01
+ 4 -3.71082E-02 -6.03075E-03
+4 0 *********** SCCC-thr-gln
+ 1 -4.41395E-01 4.65881E-01
+ 2 -1.55335E-01 3.14635E-01
+ 3 1.02257E-01 -6.64029E-03
+ 4 -6.18051E-02 2.89429E-02
+4 0 *********** SCCC-thr-asn
+ 1 -4.72320E-01 5.74738E-01
+ 2 -3.35595E-01 3.41979E-01
+ 3 1.46187E-01 -6.66184E-02
+ 4 -3.67170E-02 3.49577E-03
+4 0 *********** SCCC-thr-glu
+ 1 -4.62449E-01 4.68203E-01
+ 2 -1.76282E-01 3.50327E-01
+ 3 1.19657E-01 -2.73218E-02
+ 4 -6.87305E-02 2.78182E-02
+4 0 *********** SCCC-thr-asp
+ 1 -4.08611E-01 6.38711E-01
+ 2 -3.01493E-01 3.03020E-01
+ 3 1.00627E-01 -4.21641E-02
+ 4 -2.20284E-02 1.95056E-02
+4 0 *********** SCCC-thr-his
+ 1 -4.92681E-01 5.36284E-01
+ 2 -2.78324E-01 3.74692E-01
+ 3 1.33112E-01 -7.34918E-02
+ 4 -5.65971E-02 1.01269E-02
+4 0 *********** SCCC-thr-arg
+ 1 -4.38676E-01 3.23477E-01
+ 2 -2.00344E-02 2.91896E-01
+ 3 9.97282E-02 2.83136E-02
+ 4 -7.14757E-02 3.99299E-02
+4 0 *********** SCCC-thr-lys
+ 1 -4.49493E-01 2.63701E-01
+ 2 2.00045E-02 3.02440E-01
+ 3 1.06750E-01 2.81631E-02
+ 4 -7.80944E-02 4.32498E-02
+4 0 *********** SCCC-thr-pro
+ 1 -6.16861E-01 5.06683E-01
+ 2 -5.59323E-01 3.36619E-01
+ 3 2.94052E-01 -2.36924E-03
+ 4 -4.94889E-02 -7.00470E-03
+4 0 *********** SCCC-ser-cys
+ 1 -6.14117E-01 1.22660E+00
+ 2 3.23261E-01 7.23900E-02
+ 3 2.41012E-01 4.97487E-03
+ 4 -2.49760E-02 9.82312E-02
+4 0 *********** SCCC-ser-met
+ 1 -7.07862E-01 9.52492E-01
+ 2 4.09950E-01 -2.20340E-01
+ 3 2.88134E-01 5.89095E-02
+ 4 7.10558E-03 2.29656E-02
+4 0 *********** SCCC-ser-phe
+ 1 -8.29809E-01 9.37670E-01
+ 2 4.27039E-01 -1.78466E-01
+ 3 2.74963E-01 2.72161E-02
+ 4 -8.49620E-03 4.09213E-02
+4 0 *********** SCCC-ser-ile
+ 1 -6.59256E-01 1.11401E+00
+ 2 4.22297E-01 -2.32032E-01
+ 3 2.53826E-01 8.84966E-02
+ 4 2.36811E-02 2.29557E-02
+4 0 *********** SCCC-ser-leu
+ 1 -8.26008E-01 8.81905E-01
+ 2 4.94684E-01 -2.48984E-01
+ 3 2.57634E-01 4.86923E-02
+ 4 1.86146E-02 1.20043E-02
+4 0 *********** SCCC-ser-val
+ 1 -7.12861E-01 1.02145E+00
+ 2 4.48908E-01 -2.56107E-01
+ 3 2.61644E-01 8.33860E-02
+ 4 2.22000E-02 1.47398E-02
+4 0 *********** SCCC-ser-trp
+ 1 -7.35939E-01 1.02731E+00
+ 2 3.56372E-01 -1.55509E-01
+ 3 2.80891E-01 4.49671E-02
+ 4 -1.09244E-02 4.27441E-02
+4 0 *********** SCCC-ser-tyr
+ 1 -8.13365E-01 9.36889E-01
+ 2 4.24170E-01 -1.83317E-01
+ 3 2.79732E-01 2.92346E-02
+ 4 -8.21499E-03 3.97292E-02
+4 0 *********** SCCC-ser-ala
+ 1 -6.94355E-01 7.47595E-01
+ 2 4.01523E-01 -2.42266E-01
+ 3 3.03588E-01 3.89900E-03
+ 4 7.86446E-03 2.13287E-02
+4 0 *********** SCCC-ser-gly
+ 1 1.77164E+00 3.10725E-01
+ 2 -5.85324E-01 -7.31660E-02
+ 3 -1.01387E-01 -4.59069E-02
+ 4 1.34316E-01 8.63920E-02
+4 0 *********** SCCC-ser-thr
+ 1 -4.84627E-01 9.53395E-01
+ 2 2.17104E-01 -2.83582E-02
+ 3 2.94659E-01 6.90198E-03
+ 4 -1.19554E-02 7.05146E-02
+4 0 *********** SCCC-ser-ser
+ 1 -6.21312E-01 1.49267E+00
+ 2 3.92170E-01 3.28443E-01
+ 3 4.93930E-02 3.05009E-02
+ 4 -6.14712E-02 1.08455E-01
+4 0 *********** SCCC-ser-gln
+ 1 -5.33111E-01 1.14069E+00
+ 2 2.83721E-01 -9.01366E-02
+ 3 3.01803E-01 4.71410E-02
+ 4 -1.19502E-02 5.74736E-02
+4 0 *********** SCCC-ser-asn
+ 1 -3.84750E-01 1.32124E+00
+ 2 1.61357E-01 2.77083E-01
+ 3 2.03604E-01 -4.29290E-02
+ 4 -4.13240E-02 1.18300E-01
+4 0 *********** SCCC-ser-glu
+ 1 -6.14153E-01 1.17658E+00
+ 2 3.45757E-01 -7.75638E-02
+ 3 2.75174E-01 4.37628E-02
+ 4 -7.45559E-03 6.14123E-02
+4 0 *********** SCCC-ser-asp
+ 1 -1.86171E-01 1.47209E+00
+ 2 7.09682E-02 2.36619E-01
+ 3 2.43295E-01 5.22303E-02
+ 4 -7.72583E-02 7.89627E-02
+4 0 *********** SCCC-ser-his
+ 1 -6.69450E-01 1.34906E+00
+ 2 3.61362E-01 5.03783E-02
+ 3 1.78236E-01 7.50658E-02
+ 4 -2.01136E-02 7.16205E-02
+4 0 *********** SCCC-ser-arg
+ 1 -6.37662E-01 9.32217E-01
+ 2 3.70289E-01 -2.52955E-01
+ 3 3.15748E-01 5.65638E-02
+ 4 -4.68488E-03 2.00131E-02
+4 0 *********** SCCC-ser-lys
+ 1 -7.09024E-01 8.53952E-01
+ 2 4.41752E-01 -2.78632E-01
+ 3 2.81905E-01 5.04275E-02
+ 4 1.69044E-02 1.04063E-02
+4 0 *********** SCCC-ser-pro
+ 1 -9.67425E-01 1.39575E+00
+ 2 4.11182E-01 6.44769E-01
+ 3 1.03654E-01 1.95730E-02
+ 4 -1.72233E-01 9.52962E-02
+4 0 *********** SCCC-gln-cys
+ 1 -1.34193E-01 6.95126E-01
+ 2 1.36249E-01 -1.25291E-01
+ 3 -4.39939E-02 1.41835E-02
+ 4 -3.51733E-02 1.31322E-02
+4 0 *********** SCCC-gln-met
+ 1 -1.40747E-01 5.93268E-01
+ 2 9.50158E-02 -1.57052E-01
+ 3 -3.29856E-02 -3.69531E-03
+ 4 -3.20695E-02 1.00777E-03
+4 0 *********** SCCC-gln-phe
+ 1 -1.85231E-01 6.00285E-01
+ 2 1.17086E-01 -1.55367E-01
+ 3 -4.40100E-02 -1.46880E-04
+ 4 -2.94278E-02 -5.55207E-04
+4 0 *********** SCCC-gln-ile
+ 1 -9.10324E-02 6.44284E-01
+ 2 8.31625E-02 -1.60026E-01
+ 3 -2.21222E-02 1.02181E-02
+ 4 -3.45467E-02 4.52397E-03
+4 0 *********** SCCC-gln-leu
+ 1 -1.75889E-01 5.70684E-01
+ 2 1.03674E-01 -1.74521E-01
+ 3 -4.09702E-02 -8.32933E-04
+ 4 -2.97803E-02 -3.97702E-03
+4 0 *********** SCCC-gln-val
+ 1 -1.17794E-01 6.14597E-01
+ 2 8.70584E-02 -1.66263E-01
+ 3 -2.69350E-02 4.96618E-03
+ 4 -3.28492E-02 6.00545E-04
+4 0 *********** SCCC-gln-trp
+ 1 -1.53299E-01 6.24973E-01
+ 2 1.08601E-01 -1.40354E-01
+ 3 -3.62284E-02 -1.33675E-05
+ 4 -3.25877E-02 3.49419E-03
+4 0 *********** SCCC-gln-tyr
+ 1 -1.80419E-01 5.98660E-01
+ 2 1.14837E-01 -1.55866E-01
+ 3 -4.31960E-02 -8.29990E-04
+ 4 -2.94669E-02 -2.09085E-04
+4 0 *********** SCCC-gln-ala
+ 1 -1.72648E-01 5.03529E-01
+ 2 8.54986E-02 -1.66546E-01
+ 3 -4.37300E-02 -1.74088E-02
+ 4 -2.66354E-02 -3.54927E-03
+4 0 *********** SCCC-gln-gly
+ 1 7.68867E-01 -4.83872E-02
+ 2 -5.98158E-02 1.93480E-01
+ 3 -5.95897E-02 8.53053E-04
+ 4 -2.02137E-02 2.28224E-02
+4 0 *********** SCCC-gln-thr
+ 1 -1.03983E-01 5.91488E-01
+ 2 9.45148E-02 -9.78836E-02
+ 3 -3.46218E-02 -1.91000E-02
+ 4 -2.38546E-02 7.09047E-03
+4 0 *********** SCCC-gln-ser
+ 1 -1.49127E-01 7.45891E-01
+ 2 1.58965E-01 -1.33384E-01
+ 3 -4.81319E-02 3.50647E-02
+ 4 -4.05732E-02 1.50022E-02
+4 0 *********** SCCC-gln-gln
+ 1 -8.96216E-02 6.51434E-01
+ 2 9.66373E-02 -1.23163E-01
+ 3 -2.96888E-02 -1.83816E-03
+ 4 -3.51919E-02 1.35639E-02
+4 0 *********** SCCC-gln-asn
+ 1 -1.04911E-01 6.91553E-01
+ 2 1.37545E-01 -8.88920E-02
+ 3 -5.17290E-02 6.11594E-03
+ 4 -3.12069E-02 1.68626E-02
+4 0 *********** SCCC-gln-glu
+ 1 -1.10601E-01 6.73042E-01
+ 2 1.11771E-01 -1.36486E-01
+ 3 -3.39155E-02 9.31456E-03
+ 4 -3.62744E-02 1.23069E-02
+4 0 *********** SCCC-gln-asp
+ 1 -2.98098E-02 6.82432E-01
+ 2 1.00861E-01 -6.79492E-02
+ 3 -3.73643E-02 -1.07486E-02
+ 4 -3.56411E-02 3.22553E-02
+4 0 *********** SCCC-gln-his
+ 1 -1.32299E-01 7.16173E-01
+ 2 1.32475E-01 -1.31555E-01
+ 3 -3.64503E-02 2.25037E-02
+ 4 -3.97687E-02 1.09480E-02
+4 0 *********** SCCC-gln-arg
+ 1 -1.19110E-01 5.73573E-01
+ 2 7.84065E-02 -1.55219E-01
+ 3 -2.99762E-02 -1.01147E-02
+ 4 -2.99750E-02 3.08938E-03
+4 0 *********** SCCC-gln-lys
+ 1 -1.45598E-01 5.45942E-01
+ 2 8.13527E-02 -1.73132E-01
+ 3 -3.41550E-02 -7.35472E-03
+ 4 -2.87123E-02 -3.80024E-03
+4 0 *********** SCCC-gln-pro
+ 1 -2.90448E-01 7.30120E-01
+ 2 2.27678E-01 -9.03995E-02
+ 3 -7.91464E-02 1.76609E-03
+ 4 -6.82776E-02 -3.21575E-02
+4 0 *********** SCCC-asn-cys
+ 1 -1.62150E-01 9.56855E-01
+ 2 3.46774E-01 6.06181E-02
+ 3 -2.48439E-03 -1.07124E-01
+ 4 -1.93826E-02 -5.75492E-03
+4 0 *********** SCCC-asn-met
+ 1 -2.65641E-01 7.96242E-01
+ 2 2.76915E-01 -1.64132E-01
+ 3 5.36865E-02 -1.30750E-01
+ 4 6.16549E-03 -4.87446E-02
+4 0 *********** SCCC-asn-phe
+ 1 -3.43347E-01 7.96600E-01
+ 2 3.02311E-01 -1.26055E-01
+ 3 3.07028E-02 -1.49390E-01
+ 4 9.55578E-03 -3.33538E-02
+4 0 *********** SCCC-asn-ile
+ 1 -1.76683E-01 8.81392E-01
+ 2 2.91790E-01 -1.55566E-01
+ 3 3.48252E-02 -8.64962E-02
+ 4 8.49137E-03 -5.88552E-02
+4 0 *********** SCCC-asn-leu
+ 1 -3.48201E-01 7.56475E-01
+ 2 3.06465E-01 -2.02490E-01
+ 3 3.34965E-02 -1.42360E-01
+ 4 1.40298E-02 -5.24899E-02
+4 0 *********** SCCC-asn-val
+ 1 -2.35641E-01 8.31220E-01
+ 2 2.90214E-01 -1.84412E-01
+ 3 4.13827E-02 -1.06222E-01
+ 4 1.25033E-02 -5.92918E-02
+4 0 *********** SCCC-asn-trp
+ 1 -2.66358E-01 8.45706E-01
+ 2 2.78264E-01 -8.90219E-02
+ 3 4.03001E-02 -1.27723E-01
+ 4 1.20405E-03 -3.48995E-02
+4 0 *********** SCCC-asn-tyr
+ 1 -3.34660E-01 7.94759E-01
+ 2 2.99689E-01 -1.31033E-01
+ 3 3.36287E-02 -1.49084E-01
+ 4 9.12004E-03 -3.43792E-02
+4 0 *********** SCCC-asn-ala
+ 1 -3.30662E-01 6.69391E-01
+ 2 2.48345E-01 -2.23211E-01
+ 3 5.77542E-02 -1.72134E-01
+ 4 3.82538E-03 -4.57734E-02
+4 0 *********** SCCC-asn-gly
+ 1 1.10894E+00 -1.29810E-01
+ 2 -4.78939E-01 7.85185E-02
+ 3 -7.36233E-02 -1.00234E-01
+ 4 2.99417E-02 -9.03175E-03
+4 0 *********** SCCC-asn-thr
+ 1 -1.51014E-01 8.07619E-01
+ 2 2.17752E-01 -1.99694E-02
+ 3 7.28192E-02 -1.41545E-01
+ 4 3.57693E-03 -7.97927E-03
+4 0 *********** SCCC-asn-ser
+ 1 -1.31708E-01 1.06546E+00
+ 2 4.34947E-01 1.74209E-01
+ 3 -7.78470E-02 -4.52594E-02
+ 4 -4.85106E-02 1.14087E-02
+4 0 *********** SCCC-asn-gln
+ 1 -1.21385E-01 8.99405E-01
+ 2 2.65511E-01 -4.19733E-02
+ 3 5.20222E-02 -1.10583E-01
+ 4 -1.46111E-02 -2.96657E-02
+4 0 *********** SCCC-asn-asn
+ 1 -5.08046E-02 9.88061E-01
+ 2 3.16621E-01 1.83519E-01
+ 3 -1.77269E-02 -1.06868E-01
+ 4 -4.05749E-02 1.86697E-02
+4 0 *********** SCCC-asn-glu
+ 1 -1.57210E-01 9.22129E-01
+ 2 3.11531E-01 -3.52836E-02
+ 3 2.48361E-02 -1.04413E-01
+ 4 -1.10658E-02 -3.04204E-02
+4 0 *********** SCCC-asn-asp
+ 1 9.55026E-02 1.01758E+00
+ 2 2.48931E-01 1.71751E-01
+ 3 3.33383E-02 -7.99290E-02
+ 4 -7.93974E-02 1.49526E-02
+4 0 *********** SCCC-asn-his
+ 1 -1.50728E-01 1.00865E+00
+ 2 3.59980E-01 6.26670E-02
+ 3 -1.59120E-02 -6.06809E-02
+ 4 -2.20277E-02 -1.97543E-02
+4 0 *********** SCCC-asn-arg
+ 1 -2.31193E-01 7.75213E-01
+ 2 2.43046E-01 -1.87487E-01
+ 3 6.78871E-02 -1.37402E-01
+ 4 8.71368E-04 -4.71793E-02
+4 0 *********** SCCC-asn-lys
+ 1 -2.94462E-01 7.32113E-01
+ 2 2.65544E-01 -2.33553E-01
+ 3 5.34956E-02 -1.38595E-01
+ 4 1.06220E-02 -5.66873E-02
+4 0 *********** SCCC-asn-pro
+ 1 -3.40017E-01 1.01307E+00
+ 2 4.38875E-01 3.77154E-01
+ 3 -3.01538E-02 -1.07491E-01
+ 4 -1.02658E-01 -4.59325E-02
+4 0 *********** SCCC-glu-cys
+ 1 -1.75028E-01 7.93185E-01
+ 2 1.39923E-01 -1.97325E-01
+ 3 5.11717E-03 -4.48841E-02
+ 4 -2.09619E-02 4.12788E-03
+4 0 *********** SCCC-glu-met
+ 1 -1.73920E-01 6.75570E-01
+ 2 9.16265E-02 -2.19977E-01
+ 3 5.01779E-03 -6.20543E-02
+ 4 -1.83131E-02 -7.12865E-03
+4 0 *********** SCCC-glu-phe
+ 1 -2.26687E-01 6.83802E-01
+ 2 1.18721E-01 -2.18522E-01
+ 3 -5.53577E-03 -5.69417E-02
+ 4 -1.52122E-02 -7.95138E-03
+4 0 *********** SCCC-glu-ile
+ 1 -1.22022E-01 7.37308E-01
+ 2 7.53497E-02 -2.28979E-01
+ 3 1.52193E-02 -4.74620E-02
+ 4 -2.20326E-02 -5.38584E-03
+4 0 *********** SCCC-glu-leu
+ 1 -2.13868E-01 6.50347E-01
+ 2 1.02371E-01 -2.38147E-01
+ 3 -6.84325E-03 -5.99558E-02
+ 4 -1.60185E-02 -1.25296E-02
+4 0 *********** SCCC-glu-val
+ 1 -1.50483E-01 7.02101E-01
+ 2 8.11514E-02 -2.33310E-01
+ 3 9.48777E-03 -5.28115E-02
+ 4 -1.98443E-02 -8.59830E-03
+4 0 *********** SCCC-glu-trp
+ 1 -1.90709E-01 7.12034E-01
+ 2 1.08397E-01 -2.03549E-01
+ 3 5.93232E-03 -5.50367E-02
+ 4 -1.87646E-02 -3.46632E-03
+4 0 *********** SCCC-glu-tyr
+ 1 -2.20808E-01 6.81845E-01
+ 2 1.15825E-01 -2.18922E-01
+ 3 -4.88019E-03 -5.82385E-02
+ 4 -1.52258E-02 -7.67458E-03
+4 0 *********** SCCC-glu-ala
+ 1 -2.02807E-01 5.71139E-01
+ 2 8.14762E-02 -2.19988E-01
+ 3 -1.40082E-02 -7.89186E-02
+ 4 -1.19888E-02 -1.04592E-02
+4 0 *********** SCCC-glu-gly
+ 1 8.97790E-01 -2.27123E-02
+ 2 -2.62402E-02 2.74987E-01
+ 3 7.65727E-03 1.24542E-02
+ 4 -1.52370E-02 8.04106E-03
+4 0 *********** SCCC-glu-thr
+ 1 -1.26316E-01 6.66038E-01
+ 2 9.50929E-02 -1.45733E-01
+ 3 6.48408E-03 -7.28985E-02
+ 4 -7.56382E-03 2.86168E-03
+4 0 *********** SCCC-glu-ser
+ 1 -2.03413E-01 8.58359E-01
+ 2 1.66860E-01 -2.20439E-01
+ 3 6.60586E-03 -2.01982E-02
+ 4 -2.94999E-02 3.44116E-03
+4 0 *********** SCCC-glu-gln
+ 1 -1.16987E-01 7.41144E-01
+ 2 9.21413E-02 -1.86101E-01
+ 3 1.45002E-02 -6.22335E-02
+ 4 -2.07142E-02 5.13481E-03
+4 0 *********** SCCC-glu-asn
+ 1 -1.34928E-01 7.81608E-01
+ 2 1.43251E-01 -1.48459E-01
+ 3 -4.90144E-03 -5.56245E-02
+ 4 -1.31215E-02 7.87766E-03
+4 0 *********** SCCC-glu-glu
+ 1 -1.45328E-01 7.68498E-01
+ 2 1.09251E-01 -2.06419E-01
+ 3 1.10565E-02 -5.13099E-02
+ 4 -2.27145E-02 2.62237E-03
+4 0 *********** SCCC-glu-asp
+ 1 -4.44767E-02 7.71662E-01
+ 2 9.57822E-02 -1.23086E-01
+ 3 1.18016E-02 -7.93886E-02
+ 4 -1.81803E-02 2.32727E-02
+4 0 *********** SCCC-glu-his
+ 1 -1.77390E-01 8.22192E-01
+ 2 1.35512E-01 -2.10222E-01
+ 3 1.66831E-02 -3.09861E-02
+ 4 -2.79671E-02 2.59738E-03
+4 0 *********** SCCC-glu-arg
+ 1 -1.46782E-01 6.52472E-01
+ 2 7.13978E-02 -2.14584E-01
+ 3 5.11771E-03 -7.00618E-02
+ 4 -1.59487E-02 -4.55723E-03
+4 0 *********** SCCC-glu-lys
+ 1 -1.76250E-01 6.21346E-01
+ 2 7.58678E-02 -2.33049E-01
+ 3 -2.59398E-03 -6.66189E-02
+ 4 -1.48581E-02 -1.15323E-02
+4 0 *********** SCCC-glu-pro
+ 1 -3.72547E-01 8.37364E-01
+ 2 2.71202E-01 -1.95828E-01
+ 3 -7.88203E-03 -1.39372E-02
+ 4 -6.89503E-02 -3.81628E-02
+4 0 *********** SCCC-asp-cys
+ 1 6.89146E-03 9.62901E-01
+ 2 2.89389E-01 2.34632E-01
+ 3 6.71682E-02 -1.58876E-01
+ 4 9.88754E-02 9.45503E-03
+4 0 *********** SCCC-asp-met
+ 1 -1.63376E-01 7.49125E-01
+ 2 2.66037E-01 -2.98849E-02
+ 3 1.20566E-01 -1.84298E-01
+ 4 1.11529E-01 -1.32414E-02
+4 0 *********** SCCC-asp-phe
+ 1 -2.29384E-01 7.55678E-01
+ 2 2.61144E-01 6.87120E-03
+ 3 1.08042E-01 -2.08570E-01
+ 4 1.11254E-01 9.27824E-04
+4 0 *********** SCCC-asp-ile
+ 1 -5.28974E-02 8.29422E-01
+ 2 2.91790E-01 4.88933E-03
+ 3 9.00759E-02 -1.52680E-01
+ 4 1.19320E-01 -2.24447E-02
+4 0 *********** SCCC-asp-leu
+ 1 -2.40931E-01 7.02691E-01
+ 2 2.86859E-01 -6.60185E-02
+ 3 1.08285E-01 -2.05115E-01
+ 4 1.14096E-01 -1.03636E-02
+4 0 *********** SCCC-asp-val
+ 1 -1.21797E-01 7.76321E-01
+ 2 2.86876E-01 -3.45549E-02
+ 3 1.02586E-01 -1.70534E-01
+ 4 1.19843E-01 -1.94708E-02
+4 0 *********** SCCC-asp-trp
+ 1 -1.54704E-01 8.11497E-01
+ 2 2.42768E-01 4.74845E-02
+ 3 1.07068E-01 -1.83322E-01
+ 4 1.08048E-01 -4.05058E-03
+4 0 *********** SCCC-asp-tyr
+ 1 -2.22323E-01 7.53145E-01
+ 2 2.62355E-01 1.71466E-03
+ 3 1.10226E-01 -2.07274E-01
+ 4 1.11028E-01 -4.76266E-04
+4 0 *********** SCCC-asp-ala
+ 1 -2.58419E-01 6.24448E-01
+ 2 2.47257E-01 -1.18176E-01
+ 3 1.31675E-01 -2.10078E-01
+ 4 8.96703E-02 -1.46616E-02
+4 0 *********** SCCC-asp-gly
+ 1 1.11938E+00 -4.79483E-01
+ 2 -5.39968E-01 -2.59984E-01
+ 3 -4.20150E-02 -6.95953E-02
+ 4 6.07620E-02 -6.31520E-03
+4 0 *********** SCCC-asp-thr
+ 1 -7.14183E-02 7.90607E-01
+ 2 1.99141E-01 8.39682E-02
+ 3 1.38223E-01 -1.56640E-01
+ 4 8.44660E-02 6.23549E-03
+4 0 *********** SCCC-asp-ser
+ 1 1.48522E-01 1.14542E+00
+ 2 3.41212E-01 4.51183E-01
+ 3 -4.27583E-02 -8.22659E-02
+ 4 4.58009E-02 1.89451E-02
+4 0 *********** SCCC-asp-gln
+ 1 -3.80731E-03 8.76195E-01
+ 2 2.52369E-01 1.02246E-01
+ 3 1.12769E-01 -1.53550E-01
+ 4 9.98621E-02 -1.12339E-02
+4 0 *********** SCCC-asp-asn
+ 1 1.22758E-01 1.04207E+00
+ 2 2.53169E-01 3.63126E-01
+ 3 3.65086E-02 -1.26146E-01
+ 4 5.72966E-02 1.44893E-02
+4 0 *********** SCCC-asp-glu
+ 1 -1.60424E-02 8.99494E-01
+ 2 2.84138E-01 1.27096E-01
+ 3 9.00957E-02 -1.62470E-01
+ 4 1.09158E-01 -7.72673E-03
+4 0 *********** SCCC-asp-asp
+ 1 2.59374E-01 1.06658E+00
+ 2 2.34343E-01 3.50566E-01
+ 3 7.94228E-02 -7.82301E-02
+ 4 3.04771E-02 3.42785E-03
+4 0 *********** SCCC-asp-his
+ 1 4.14244E-02 1.01882E+00
+ 2 3.00553E-01 2.68657E-01
+ 3 3.96480E-02 -1.19962E-01
+ 4 9.49039E-02 8.52413E-03
+4 0 *********** SCCC-asp-arg
+ 1 -1.43057E-01 7.27323E-01
+ 2 2.47012E-01 -6.37525E-02
+ 3 1.29984E-01 -1.81607E-01
+ 4 9.96790E-02 -1.96414E-02
+4 0 *********** SCCC-asp-lys
+ 1 -2.06415E-01 6.77904E-01
+ 2 2.68843E-01 -1.08164E-01
+ 3 1.19636E-01 -1.89430E-01
+ 4 1.04245E-01 -1.92013E-02
+4 0 *********** SCCC-asp-pro
+ 1 -1.38898E-01 1.27123E+00
+ 2 1.99963E-01 7.69688E-01
+ 3 1.91683E-01 -3.21063E-01
+ 4 -1.48049E-01 2.78634E-01
+4 0 *********** SCCC-his-cys
+ 1 -3.69345E-01 1.02232E+00
+ 2 2.73396E-01 -1.37066E-01
+ 3 5.51468E-02 -1.69168E-01
+ 4 -7.02196E-02 2.82981E-02
+4 0 *********** SCCC-his-met
+ 1 -3.81561E-01 8.61414E-01
+ 2 2.24917E-01 -2.76206E-01
+ 3 6.00277E-02 -1.65478E-01
+ 4 -4.49430E-02 -4.76821E-02
+4 0 *********** SCCC-his-phe
+ 1 -4.68949E-01 8.57245E-01
+ 2 2.62629E-01 -2.41380E-01
+ 3 4.20567E-02 -1.82999E-01
+ 4 -4.95250E-02 -3.34942E-02
+4 0 *********** SCCC-his-ile
+ 1 -3.28031E-01 9.70230E-01
+ 2 2.22628E-01 -3.00284E-01
+ 3 4.74535E-02 -1.22181E-01
+ 4 -3.95713E-02 -4.37272E-02
+4 0 *********** SCCC-his-leu
+ 1 -4.56076E-01 8.14821E-01
+ 2 2.65737E-01 -2.99845E-01
+ 3 2.74991E-02 -1.75545E-01
+ 4 -3.45093E-02 -5.38870E-02
+4 0 *********** SCCC-his-val
+ 1 -3.66815E-01 9.09384E-01
+ 2 2.32540E-01 -3.08934E-01
+ 3 4.54471E-02 -1.39055E-01
+ 4 -3.53282E-02 -5.26108E-02
+4 0 *********** SCCC-his-trp
+ 1 -4.04562E-01 9.12636E-01
+ 2 2.29576E-01 -2.23804E-01
+ 3 6.41183E-02 -1.61855E-01
+ 4 -5.73424E-02 -3.13866E-02
+4 0 *********** SCCC-his-tyr
+ 1 -4.58121E-01 8.55671E-01
+ 2 2.57802E-01 -2.45122E-01
+ 3 4.46526E-02 -1.83509E-01
+ 4 -4.96869E-02 -3.37290E-02
+4 0 *********** SCCC-his-ala
+ 1 -3.95989E-01 7.05652E-01
+ 2 2.07209E-01 -2.84327E-01
+ 3 4.39849E-02 -2.13866E-01
+ 4 -4.07812E-02 -5.09985E-02
+4 0 *********** SCCC-his-gly
+ 1 1.25852E+00 1.76141E-01
+ 2 -2.77315E-01 3.24357E-01
+ 3 4.54429E-02 -7.91989E-02
+ 4 1.99718E-02 4.65286E-02
+4 0 *********** SCCC-his-thr
+ 1 -2.58759E-01 8.49473E-01
+ 2 1.63800E-01 -1.27977E-01
+ 3 9.93722E-02 -1.98211E-01
+ 4 -4.68005E-02 1.04977E-03
+4 0 *********** SCCC-his-ser
+ 1 -4.42381E-01 1.12152E+00
+ 2 3.64904E-01 -1.17923E-01
+ 3 1.22945E-02 -1.22412E-01
+ 4 -8.14961E-02 5.24886E-02
+4 0 *********** SCCC-his-gln
+ 1 -2.74803E-01 9.71741E-01
+ 2 1.86757E-01 -1.96807E-01
+ 3 9.06279E-02 -1.60756E-01
+ 4 -7.07205E-02 -7.42647E-03
+4 0 *********** SCCC-his-asn
+ 1 -2.59373E-01 1.01077E+00
+ 2 2.37818E-01 -1.69224E-02
+ 3 5.04090E-02 -2.04248E-01
+ 4 -6.44461E-02 6.27076E-02
+4 0 *********** SCCC-his-glu
+ 1 -3.34689E-01 1.00225E+00
+ 2 2.34058E-01 -2.08542E-01
+ 3 6.62179E-02 -1.52845E-01
+ 4 -6.77561E-02 -2.88808E-03
+4 0 *********** SCCC-his-asp
+ 1 -1.13489E-01 1.05146E+00
+ 2 1.36018E-01 -4.44790E-02
+ 3 1.26749E-01 -1.82384E-01
+ 4 -1.23555E-01 6.77906E-02
+4 0 *********** SCCC-his-his
+ 1 -3.94646E-01 1.08754E+00
+ 2 2.91579E-01 -1.75765E-01
+ 3 5.16481E-02 -1.10558E-01
+ 4 -7.10761E-02 5.27062E-03
+4 0 *********** SCCC-his-arg
+ 1 -3.30066E-01 8.37721E-01
+ 2 1.84874E-01 -2.86796E-01
+ 3 7.31266E-02 -1.74279E-01
+ 4 -5.31747E-02 -4.43825E-02
+4 0 *********** SCCC-his-lys
+ 1 -3.81706E-01 7.86125E-01
+ 2 2.18531E-01 -3.16421E-01
+ 3 4.33274E-02 -1.75276E-01
+ 4 -3.24525E-02 -5.78990E-02
+4 0 *********** SCCC-his-pro
+ 1 -7.30659E-01 1.01721E+00
+ 2 4.71006E-01 1.74010E-02
+ 3 6.27875E-02 -1.49403E-01
+ 4 -1.64736E-01 2.55952E-02
+4 0 *********** SCCC-arg-cys
+ 1 -4.73342E-01 2.53493E-01
+ 2 -1.04818E-01 -1.89795E-02
+ 3 7.72408E-02 4.49749E-02
+ 4 -7.40174E-02 1.81466E-04
+4 0 *********** SCCC-arg-met
+ 1 -4.05113E-01 1.78167E-01
+ 2 -6.21818E-02 2.92029E-02
+ 3 4.53693E-02 3.55998E-02
+ 4 -5.40860E-02 -8.65102E-03
+4 0 *********** SCCC-arg-phe
+ 1 -4.23597E-01 1.58949E-01
+ 2 -6.66038E-02 2.47021E-02
+ 3 5.03868E-02 4.11327E-02
+ 4 -5.78930E-02 -1.16976E-02
+4 0 *********** SCCC-arg-ile
+ 1 -4.15299E-01 2.35567E-01
+ 2 -7.24346E-02 2.09376E-02
+ 3 5.24164E-02 2.56747E-02
+ 4 -5.30972E-02 2.01269E-03
+4 0 *********** SCCC-arg-leu
+ 1 -3.98462E-01 1.45644E-01
+ 2 -5.52901E-02 4.37980E-02
+ 3 4.47608E-02 3.54917E-02
+ 4 -5.30811E-02 -9.74845E-03
+4 0 *********** SCCC-arg-val
+ 1 -4.06142E-01 2.03001E-01
+ 2 -6.40740E-02 3.03356E-02
+ 3 4.75051E-02 2.89481E-02
+ 4 -5.20303E-02 -2.96945E-03
+4 0 *********** SCCC-arg-trp
+ 1 -4.32196E-01 1.90354E-01
+ 2 -7.31097E-02 1.01073E-02
+ 3 5.22349E-02 4.08552E-02
+ 4 -5.90120E-02 -1.00659E-02
+4 0 *********** SCCC-arg-tyr
+ 1 -4.21075E-01 1.60625E-01
+ 2 -6.61055E-02 2.56922E-02
+ 3 4.99396E-02 4.05342E-02
+ 4 -5.75701E-02 -1.11830E-02
+4 0 *********** SCCC-arg-ala
+ 1 -3.62189E-01 1.07613E-01
+ 2 -3.86273E-02 5.48172E-02
+ 3 3.46412E-02 3.64830E-02
+ 4 -4.69961E-02 -1.27651E-02
+4 0 *********** SCCC-arg-gly
+ 1 4.00182E-01 4.17668E-01
+ 2 1.17543E-01 -2.63219E-02
+ 3 3.09356E-02 8.67132E-02
+ 4 -2.98912E-02 6.19530E-02
+4 0 *********** SCCC-arg-thr
+ 1 -4.09575E-01 1.99549E-01
+ 2 -7.32878E-02 -1.88423E-03
+ 3 4.29009E-02 4.11909E-02
+ 4 -5.15602E-02 -1.08618E-02
+4 0 *********** SCCC-arg-ser
+ 1 -5.05874E-01 2.84182E-01
+ 2 -1.22501E-01 -3.54938E-02
+ 3 9.70116E-02 4.64495E-02
+ 4 -8.46584E-02 8.18824E-03
+4 0 *********** SCCC-arg-gln
+ 1 -4.32396E-01 2.43546E-01
+ 2 -8.51436E-02 -2.74496E-03
+ 3 5.82585E-02 3.79556E-02
+ 4 -6.26550E-02 -2.04682E-03
+4 0 *********** SCCC-arg-asn
+ 1 -4.75275E-01 2.70643E-01
+ 2 -1.13187E-01 -3.66262E-02
+ 3 8.06719E-02 4.89900E-02
+ 4 -7.54243E-02 1.54695E-03
+4 0 *********** SCCC-arg-glu
+ 1 -4.47872E-01 2.47488E-01
+ 2 -9.19302E-02 -2.85206E-03
+ 3 6.66418E-02 3.77559E-02
+ 4 -6.67127E-02 9.88276E-04
+4 0 *********** SCCC-arg-asp
+ 1 -4.50217E-01 3.01442E-01
+ 2 -1.09243E-01 -3.98998E-02
+ 3 7.44890E-02 4.61206E-02
+ 4 -7.56613E-02 6.91330E-03
+4 0 *********** SCCC-arg-his
+ 1 -4.81948E-01 2.64773E-01
+ 2 -1.06189E-01 -2.30736E-02
+ 3 7.85526E-02 4.26425E-02
+ 4 -7.31967E-02 7.22995E-04
+4 0 *********** SCCC-arg-arg
+ 1 -3.87081E-01 1.77815E-01
+ 2 -5.42853E-02 3.40488E-02
+ 3 4.03228E-02 3.28638E-02
+ 4 -5.03760E-02 -6.84053E-03
+4 0 *********** SCCC-arg-lys
+ 1 -3.75245E-01 1.46792E-01
+ 2 -4.51987E-02 4.94359E-02
+ 3 3.73444E-02 3.13716E-02
+ 4 -4.69384E-02 -8.52284E-03
+4 0 *********** SCCC-arg-pro
+ 1 -5.95886E-01 2.06751E-01
+ 2 -8.81570E-02 -8.15618E-02
+ 3 7.14983E-02 1.19196E-01
+ 4 -9.18050E-02 -5.95070E-02
+4 0 *********** SCCC-lys-cys
+ 1 -5.47372E-01 3.16605E-01
+ 2 -2.87129E-01 -4.87277E-02
+ 3 6.85147E-02 7.82231E-02
+ 4 -2.52364E-02 4.46998E-03
+4 0 *********** SCCC-lys-met
+ 1 -4.60087E-01 1.84547E-01
+ 2 -1.81462E-01 5.61335E-02
+ 3 1.04843E-02 7.62134E-02
+ 4 -2.33361E-02 -2.58159E-02
+4 0 *********** SCCC-lys-phe
+ 1 -4.80395E-01 1.59179E-01
+ 2 -1.92525E-01 3.81188E-02
+ 3 1.47921E-02 9.02307E-02
+ 4 -2.21454E-02 -2.78217E-02
+4 0 *********** SCCC-lys-ile
+ 1 -4.74587E-01 2.65560E-01
+ 2 -2.07996E-01 5.01665E-02
+ 3 3.24299E-02 5.54556E-02
+ 4 -2.36470E-02 -1.53426E-02
+4 0 *********** SCCC-lys-leu
+ 1 -4.50611E-01 1.36362E-01
+ 2 -1.69617E-01 7.94878E-02
+ 3 7.67290E-03 8.55450E-02
+ 4 -2.33045E-02 -3.10951E-02
+4 0 *********** SCCC-lys-val
+ 1 -4.62113E-01 2.17145E-01
+ 2 -1.88623E-01 6.44282E-02
+ 3 2.02094E-02 6.54751E-02
+ 4 -2.39116E-02 -2.27431E-02
+4 0 *********** SCCC-lys-trp
+ 1 -4.93534E-01 2.07583E-01
+ 2 -2.05569E-01 1.39425E-02
+ 3 2.22329E-02 8.05416E-02
+ 4 -2.31722E-02 -2.09946E-02
+4 0 *********** SCCC-lys-tyr
+ 1 -4.77446E-01 1.61184E-01
+ 2 -1.91261E-01 4.10369E-02
+ 3 1.41410E-02 8.90870E-02
+ 4 -2.22685E-02 -2.77056E-02
+4 0 *********** SCCC-lys-ala
+ 1 -4.11165E-01 8.80741E-02
+ 2 -1.28881E-01 9.94373E-02
+ 3 -1.00122E-02 8.75506E-02
+ 4 -2.35571E-02 -3.16775E-02
+4 0 *********** SCCC-lys-gly
+ 1 5.25954E-01 4.79788E-01
+ 2 3.34916E-01 -8.65974E-02
+ 3 4.33983E-02 1.24438E-01
+ 4 -4.31657E-04 3.26861E-02
+4 0 *********** SCCC-lys-thr
+ 1 -4.71676E-01 2.27090E-01
+ 2 -1.95394E-01 -8.01890E-03
+ 3 9.16728E-03 7.08142E-02
+ 4 -1.90784E-02 -1.71305E-02
+4 0 *********** SCCC-lys-ser
+ 1 -5.98217E-01 3.88338E-01
+ 2 -3.47037E-01 -9.79754E-02
+ 3 1.20162E-01 7.50527E-02
+ 4 -3.17903E-02 3.51891E-02
+4 0 *********** SCCC-lys-gln
+ 1 -4.96946E-01 2.88272E-01
+ 2 -2.31370E-01 -2.69509E-03
+ 3 3.46963E-02 6.54058E-02
+ 4 -2.40756E-02 -7.89120E-03
+4 0 *********** SCCC-lys-asn
+ 1 -5.59296E-01 3.57317E-01
+ 2 -3.04425E-01 -9.17428E-02
+ 3 8.18186E-02 7.82304E-02
+ 4 -2.80689E-02 1.91804E-02
+4 0 *********** SCCC-lys-glu
+ 1 -5.13847E-01 2.95140E-01
+ 2 -2.52457E-01 -6.09678E-03
+ 3 4.88495E-02 6.92841E-02
+ 4 -2.43858E-02 -5.26692E-03
+4 0 *********** SCCC-lys-asp
+ 1 -5.31340E-01 3.98318E-01
+ 2 -2.85858E-01 -8.13740E-02
+ 3 6.60168E-02 6.04862E-02
+ 4 -2.90134E-02 2.37989E-02
+4 0 *********** SCCC-lys-his
+ 1 -5.61080E-01 3.38925E-01
+ 2 -2.96162E-01 -5.72318E-02
+ 3 7.95857E-02 6.88026E-02
+ 4 -2.57550E-02 1.00336E-02
+4 0 *********** SCCC-lys-arg
+ 1 -4.40771E-01 1.83017E-01
+ 2 -1.61779E-01 6.94934E-02
+ 3 3.89153E-03 7.17533E-02
+ 4 -2.44256E-02 -2.49766E-02
+4 0 *********** SCCC-lys-lys
+ 1 -4.26222E-01 1.38297E-01
+ 2 -1.45744E-01 9.62439E-02
+ 3 1.82849E-04 7.59947E-02
+ 4 -2.42978E-02 -2.99072E-02
+4 0 *********** SCCC-lys-pro
+ 1 -6.87509E-01 3.29153E-01
+ 2 -3.35348E-01 -2.51436E-01
+ 3 9.98007E-02 1.67332E-01
+ 4 -6.37424E-02 2.57929E-02
+4 0 *********** SCCC-pro-cys
+ 1 4.82339E-01 1.42614E+00
+ 2 2.73463E-03 -2.46321E-01
+ 3 -7.23621E-02 -1.95558E-01
+ 4 4.91904E-02 -1.21700E-01
+4 0 *********** SCCC-pro-met
+ 1 1.68794E-01 1.23060E+00
+ 2 -2.47973E-01 -3.80756E-01
+ 3 -4.89137E-02 -2.85234E-01
+ 4 7.05047E-02 -3.45015E-02
+4 0 *********** SCCC-pro-phe
+ 1 7.60068E-02 1.33126E+00
+ 2 -2.43027E-01 -4.13656E-01
+ 3 -4.27590E-02 -2.69401E-01
+ 4 8.27960E-02 -4.00862E-02
+4 0 *********** SCCC-pro-ile
+ 1 3.32850E-01 1.34111E+00
+ 2 -2.82477E-01 -3.67684E-01
+ 3 -2.03285E-02 -3.17522E-01
+ 4 7.74037E-02 -4.01822E-02
+4 0 *********** SCCC-pro-leu
+ 1 3.23707E-02 1.27574E+00
+ 2 -2.95285E-01 -4.75463E-01
+ 3 -1.57196E-02 -2.72307E-01
+ 4 6.35484E-02 -5.02080E-03
+4 0 *********** SCCC-pro-val
+ 1 2.19698E-01 1.30074E+00
+ 2 -2.99856E-01 -4.07424E-01
+ 3 -1.76088E-02 -3.10886E-01
+ 4 7.62449E-02 -2.36822E-02
+4 0 *********** SCCC-pro-trp
+ 1 2.11003E-01 1.32354E+00
+ 2 -2.08207E-01 -3.28018E-01
+ 3 -5.88735E-02 -2.76918E-01
+ 4 8.41015E-02 -5.71559E-02
+4 0 *********** SCCC-pro-tyr
+ 1 8.63762E-02 1.31518E+00
+ 2 -2.42393E-01 -4.09271E-01
+ 3 -4.62516E-02 -2.71177E-01
+ 4 8.18826E-02 -4.06253E-02
+4 0 *********** SCCC-pro-ala
+ 1 1.64853E-02 1.04884E+00
+ 2 -2.43450E-01 -3.94165E-01
+ 3 -8.69073E-02 -2.30146E-01
+ 4 4.56232E-02 -2.01726E-02
+4 0 *********** SCCC-pro-gly
+ 1 2.23240E+00 -2.14457E+00
+ 2 -3.37741E-01 -2.83765E-01
+ 3 -1.50305E-01 1.76072E-01
+ 4 -3.74656E-02 1.51697E-02
+4 0 *********** SCCC-pro-thr
+ 1 3.32017E-01 1.04626E+00
+ 2 -2.75534E-02 -1.86874E-01
+ 3 -1.12255E-01 -1.98801E-01
+ 4 3.64635E-02 -8.80600E-02
+4 0 *********** SCCC-pro-ser
+ 1 8.54398E-01 1.81527E+00
+ 2 2.24325E-01 -1.46596E-01
+ 3 8.57517E-02 -1.83586E-02
+ 4 6.03122E-02 -7.05508E-02
+4 0 *********** SCCC-pro-gln
+ 1 4.44934E-01 1.25153E+00
+ 2 -1.09365E-01 -2.30544E-01
+ 3 -9.20696E-02 -2.62958E-01
+ 4 5.94435E-02 -9.22573E-02
+4 0 *********** SCCC-pro-asn
+ 1 7.57578E-01 1.34308E+00
+ 2 2.45102E-01 -2.32651E-02
+ 3 -1.13890E-01 -5.77947E-02
+ 4 1.66961E-02 -1.36478E-01
+4 0 *********** SCCC-pro-glu
+ 1 4.22861E-01 1.36719E+00
+ 2 -1.29948E-01 -2.86940E-01
+ 3 -6.70773E-02 -2.68784E-01
+ 4 6.70893E-02 -9.16566E-02
+4 0 *********** SCCC-pro-asp
+ 1 1.06001E+00 1.34100E+00
+ 2 2.62307E-01 1.31717E-01
+ 3 -1.07909E-01 -9.61497E-02
+ 4 4.65401E-02 -1.17995E-01
+4 0 *********** SCCC-pro-his
+ 1 5.51527E-01 1.63451E+00
+ 2 -8.43776E-02 -2.48776E-01
+ 3 -4.05782E-03 -2.49672E-01
+ 4 9.46899E-02 -9.34989E-02
+4 0 *********** SCCC-pro-arg
+ 1 1.99155E-01 1.15004E+00
+ 2 -2.60709E-01 -3.42296E-01
+ 3 -7.54445E-02 -2.89494E-01
+ 4 7.36528E-02 -3.76496E-02
+4 0 *********** SCCC-pro-lys
+ 1 9.07982E-02 1.14370E+00
+ 2 -2.90373E-01 -4.16148E-01
+ 3 -4.75112E-02 -2.68886E-01
+ 4 5.70155E-02 -1.21007E-02
+4 0 *********** SCCC-pro-pro
+ 1 1.24017E+00 3.27182E+00
+ 2 -1.12460E-01 4.91637E-01
+ 3 -2.82130E-01 -1.04332E-01
+ 4 7.16332E-02 -3.05457E-01
+4 0 *********** CCCS-cys-cys
+ 1 -9.81529E-01 -4.99751E-01
+ 2 -1.09644E-01 -1.41325E-01
+ 3 1.66508E-01 -1.41587E-01
+ 4 -4.39297E-02 9.10503E-02
+4 0 *********** CCCS-cys-met
+ 1 -6.99952E-01 -1.25466E-02
+ 2 -2.85225E-01 1.14027E-01
+ 3 6.25110E-02 -1.10927E-01
+ 4 9.64240E-03 4.31923E-02
+4 0 *********** CCCS-cys-phe
+ 1 -7.96678E-01 7.62314E-03
+ 2 -1.22507E-01 3.16194E-01
+ 3 -9.63393E-02 -6.52523E-02
+ 4 6.16694E-02 3.56698E-02
+4 0 *********** CCCS-cys-ile
+ 1 -8.79423E-01 -5.23081E-02
+ 2 -4.10713E-01 1.40084E-01
+ 3 7.18166E-02 -1.91023E-01
+ 4 -6.05884E-03 3.82424E-02
+4 0 *********** CCCS-cys-leu
+ 1 -5.81163E-01 2.21705E-01
+ 2 -4.81013E-01 3.58596E-01
+ 3 5.49719E-03 -8.37178E-02
+ 4 -9.77924E-03 1.48720E-02
+4 0 *********** CCCS-cys-val
+ 1 -7.84291E-01 -2.84432E-03
+ 2 -4.57495E-01 1.99446E-01
+ 3 7.75864E-02 -1.60314E-01
+ 4 5.15416E-03 3.40983E-02
+4 0 *********** CCCS-cys-trp
+ 1 -8.29444E-01 4.82686E-02
+ 2 -1.53370E-01 2.12974E-01
+ 3 -6.19886E-02 -9.43079E-02
+ 4 5.74415E-02 3.56113E-02
+4 0 *********** CCCS-cys-tyr
+ 1 -7.86153E-01 1.26779E-02
+ 2 -1.02654E-01 2.97115E-01
+ 3 -9.95401E-02 -6.43182E-02
+ 4 7.04470E-02 4.13411E-02
+4 0 *********** CCCS-cys-ala
+ 1 -5.17854E-01 7.94199E-03
+ 2 -5.79857E-01 -2.26360E-01
+ 3 1.02776E-01 -3.73167E-02
+ 4 -7.85419E-03 -2.22182E-02
+4 0 *********** CCCS-cys-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-cys-thr
- 1 -2.03248E-01 5.51263E-02
- 2 3.07864E-01 3.35407E-01
- 3 -1.31526E-01 5.76879E-02
- 4 7.76138E-02 4.93284E-02
- 5 -2.03731E-01 2.87956E-02
- 6 3.61882E-02 -8.21649E-02
-6 0 *********** CCCS-cys-ser
- 1 -6.48842E-02 1.36898E-01
- 2 -2.85369E-01 7.40534E-01
- 3 -2.30651E-01 -5.16896E-02
- 4 -2.32559E-01 2.76752E-01
- 5 9.56038E-02 -1.75199E-01
- 6 -1.97013E-01 -5.81647E-01
-6 0 *********** CCCS-cys-gln
- 1 -1.19089E-01 6.39442E-02
- 2 4.15720E-02 3.88808E-01
- 3 -1.11318E-01 -1.10958E-02
- 4 -6.28745E-02 9.33107E-02
- 5 -6.14000E-02 -2.63730E-02
- 6 -5.23861E-02 -2.09296E-01
-6 0 *********** CCCS-cys-asn
- 1 -6.61606E-02 1.85503E-01
- 2 -3.57518E-01 3.10699E-01
- 3 -2.66973E-01 -9.44250E-02
- 4 -1.73004E-01 1.61665E-01
- 5 5.18439E-02 -1.19069E-01
- 6 -1.15785E-01 -3.27812E-01
-6 0 *********** CCCS-cys-glu
- 1 -1.17844E-01 6.06832E-02
- 2 1.21560E-01 4.13331E-01
- 3 -9.32532E-02 4.89565E-03
- 4 -2.69192E-02 9.16398E-02
- 5 -7.55637E-02 -1.09408E-02
- 6 -3.02019E-02 -1.96423E-01
-6 0 *********** CCCS-cys-asp
- 1 -4.71794E-02 1.49414E-01
- 2 -3.44561E-01 3.54102E-01
- 3 -2.33539E-01 1.73815E-02
- 4 -1.21900E-01 1.55722E-01
- 5 -2.29310E-02 -9.35304E-02
- 6 -1.09390E-01 -2.70399E-01
-6 0 *********** CCCS-cys-his
- 1 -1.55821E-02 2.14894E-01
- 2 -3.18337E-01 2.50889E-01
- 3 -2.76280E-01 5.03498E-02
- 4 -5.66532E-02 9.58135E-02
- 5 -1.15559E-01 -4.55931E-02
- 6 -4.50136E-02 -1.25442E-01
-6 0 *********** CCCS-cys-arg
- 1 -1.72816E-01 2.76509E-02
- 2 2.85707E-01 1.72018E-01
- 3 -6.59164E-02 -7.43103E-02
- 4 -1.07827E-02 6.06648E-02
- 5 -3.12455E-02 -3.30765E-02
- 6 -3.11861E-02 -1.57759E-01
-6 0 *********** CCCS-cys-lys
- 1 -1.89653E-01 3.09404E-02
- 2 3.35374E-01 1.48211E-01
- 3 -7.36330E-02 -5.62915E-02
- 4 2.94976E-02 4.52978E-02
- 5 -5.82360E-02 -2.29557E-02
- 6 -6.81123E-03 -1.19752E-01
-6 0 *********** CCCS-cys-pro
- 1 2.25358E-01 -5.76858E-01
- 2 -6.53319E-01 -6.51871E-01
- 3 -2.90103E-01 -4.75061E-01
- 4 -1.86345E-01 4.74952E-01
- 5 2.36789E-01 -9.96302E-02
- 6 -1.64613E-01 -5.16826E-01
-6 0 *********** CCCS-met-cys
- 1 -7.34487E-01 3.09506E-01
- 2 -1.39018E-01 4.32778E-01
- 3 -1.92234E-01 -6.32933E-02
- 4 -1.21518E-01 7.41625E-02
- 5 -6.77158E-02 -4.29534E-02
- 6 -5.92468E-02 -2.18930E-01
-6 0 *********** CCCS-met-met
- 1 -5.38620E-01 4.44836E-01
- 2 1.93475E-01 1.34595E-01
- 3 -1.07309E-01 1.13417E-02
- 4 -5.92730E-03 8.34853E-02
- 5 -1.17862E-01 -1.15213E-02
- 6 -1.13171E-02 -3.37062E-02
-6 0 *********** CCCS-met-phe
- 1 -4.83090E-01 5.63426E-01
- 2 1.74892E-01 3.47418E-02
- 3 -5.34814E-02 -6.82614E-02
- 4 -2.15618E-02 6.91379E-02
- 5 -6.09399E-02 -3.46480E-02
- 6 -2.25282E-02 -3.01455E-02
-6 0 *********** CCCS-met-ile
- 1 -5.75739E-01 5.47566E-01
- 2 2.52908E-01 1.03034E-01
- 3 -1.41761E-01 7.81617E-02
- 4 4.22093E-02 8.28848E-02
- 5 -1.64437E-01 2.79027E-03
- 6 1.18836E-02 4.28437E-02
-6 0 *********** CCCS-met-leu
- 1 -4.62855E-01 4.96060E-01
- 2 3.75177E-01 6.70144E-03
- 3 7.00004E-02 -1.55550E-02
- 4 -2.89849E-02 9.18811E-02
- 5 4.07282E-02 -3.92495E-02
- 6 -2.99345E-02 -2.49611E-02
-6 0 *********** CCCS-met-val
- 1 -5.30011E-01 5.34488E-01
- 2 2.55351E-01 3.50534E-02
- 3 -8.43881E-02 5.41744E-02
- 4 -7.14225E-03 8.91348E-02
- 5 -1.02092E-01 -9.93436E-03
- 6 -1.26755E-02 3.60313E-02
-6 0 *********** CCCS-met-trp
- 1 -4.50958E-01 5.35591E-01
- 2 1.56596E-01 1.03637E-01
- 3 -7.30201E-02 -4.82778E-02
- 4 -2.59621E-02 7.66675E-02
- 5 -6.64170E-02 -2.92903E-02
- 6 -2.50582E-02 -4.72217E-02
-6 0 *********** CCCS-met-tyr
- 1 -4.59146E-01 5.43189E-01
- 2 1.35086E-01 6.22810E-02
- 3 -2.61321E-02 -1.01795E-01
- 4 -6.90679E-02 9.18397E-02
- 5 -1.00117E-02 -4.86673E-02
- 6 -5.24642E-02 -8.88875E-02
-6 0 *********** CCCS-met-ala
- 1 -6.49265E-01 1.57538E-01
- 2 2.94074E-01 4.38016E-01
- 3 -7.55584E-02 3.20068E-02
- 4 -1.49637E-01 1.84947E-01
- 5 9.80198E-03 -2.37352E-02
- 6 -1.18694E-01 -2.48590E-01
-6 0 *********** CCCS-met-gly
+4 0 *********** CCCS-cys-thr
+ 1 -8.30177E-01 -3.53848E-02
+ 2 -3.94740E-01 -2.22237E-03
+ 3 7.19076E-02 -1.22610E-01
+ 4 -7.73690E-03 1.97299E-02
+4 0 *********** CCCS-cys-ser
+ 1 -1.11675E+00 -9.04310E-01
+ 2 7.00369E-03 -1.63392E-01
+ 3 1.63316E-01 -1.70663E-01
+ 4 -6.93816E-02 2.63151E-02
+4 0 *********** CCCS-cys-gln
+ 1 -8.54563E-01 -1.07630E-01
+ 2 -1.87343E-01 -9.34115E-02
+ 3 -5.30520E-02 -1.16920E-01
+ 4 1.54047E-02 5.70308E-02
+4 0 *********** CCCS-cys-asn
+ 1 -9.28088E-01 -6.02095E-01
+ 2 6.86611E-02 -2.44584E-01
+ 3 6.24537E-02 -7.51201E-02
+ 4 3.79455E-03 6.64844E-02
+4 0 *********** CCCS-cys-glu
+ 1 -9.51407E-01 -6.55904E-02
+ 2 -2.34702E-01 -7.11047E-03
+ 3 -5.47458E-02 -1.46273E-01
+ 4 2.51454E-02 3.57427E-02
+4 0 *********** CCCS-cys-asp
+ 1 -1.01534E+00 -7.17179E-01
+ 2 9.03379E-03 -2.23320E-01
+ 3 9.16158E-02 -5.34428E-02
+ 4 8.89365E-03 4.84009E-02
+4 0 *********** CCCS-cys-his
+ 1 -9.54598E-01 -5.73454E-01
+ 2 1.16190E-01 -1.27483E-01
+ 3 1.71071E-01 -1.29127E-01
+ 4 -2.06691E-02 2.05881E-03
+4 0 *********** CCCS-cys-arg
+ 1 -6.59082E-01 1.28634E-01
+ 2 -2.34765E-01 2.44536E-01
+ 3 -2.41314E-02 -9.57468E-02
+ 4 -7.47069E-03 1.40142E-02
+4 0 *********** CCCS-cys-lys
+ 1 -5.54585E-01 1.93256E-01
+ 2 -3.58461E-01 2.39395E-01
+ 3 5.44631E-02 -7.44114E-02
+ 4 5.48193E-03 1.04960E-02
+4 0 *********** CCCS-cys-pro
+ 1 -1.57268E+00 -7.21704E-01
+ 2 -4.01256E-02 5.03049E-02
+ 3 -4.96014E-02 -4.51269E-01
+ 4 -9.56046E-02 1.16484E-01
+4 0 *********** CCCS-met-cys
+ 1 -8.66203E-01 -4.35658E-01
+ 2 7.94597E-02 -4.44697E-02
+ 3 9.94323E-02 -1.10620E-01
+ 4 -8.77444E-04 3.10846E-02
+4 0 *********** CCCS-met-met
+ 1 -6.13072E-01 2.17128E-02
+ 2 -1.48139E-01 -1.24288E-02
+ 3 2.29492E-02 -5.93085E-02
+ 4 -9.03098E-03 4.49343E-02
+4 0 *********** CCCS-met-phe
+ 1 -6.58045E-01 8.08007E-02
+ 2 -8.59951E-02 1.04368E-01
+ 3 -1.01504E-01 -3.30910E-02
+ 4 5.29134E-02 5.26243E-02
+4 0 *********** CCCS-met-ile
+ 1 -7.69788E-01 1.00031E-02
+ 2 -1.68608E-01 -3.98670E-02
+ 3 1.35835E-02 -1.08701E-01
+ 4 -3.93300E-02 3.99990E-02
+4 0 *********** CCCS-met-leu
+ 1 -5.35859E-01 2.37305E-01
+ 2 -3.01175E-01 7.29295E-02
+ 3 -1.45616E-02 -3.71859E-02
+ 4 -2.09997E-02 8.33643E-02
+4 0 *********** CCCS-met-val
+ 1 -6.85812E-01 6.09897E-02
+ 2 -2.24886E-01 -1.19862E-02
+ 3 1.67065E-02 -8.80205E-02
+ 4 -3.09468E-02 6.03288E-02
+4 0 *********** CCCS-met-trp
+ 1 -7.04443E-01 9.44303E-02
+ 2 -8.35085E-02 3.90069E-02
+ 3 -6.82070E-02 -4.74457E-02
+ 4 3.89369E-02 4.52790E-02
+4 0 *********** CCCS-met-tyr
+ 1 -6.48983E-01 7.76534E-02
+ 2 -7.60514E-02 1.00872E-01
+ 3 -9.86517E-02 -3.30396E-02
+ 4 5.61998E-02 5.41831E-02
+4 0 *********** CCCS-met-ala
+ 1 -4.83644E-01 -5.25651E-03
+ 2 -2.57531E-01 -2.26794E-01
+ 3 5.53271E-02 -1.77366E-02
+ 4 -6.24025E-02 -6.47984E-02
+4 0 *********** CCCS-met-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-met-thr
- 1 -7.69075E-01 3.76115E-01
- 2 4.14929E-01 2.57125E-01
- 3 -1.53909E-01 8.25365E-02
- 4 -5.13141E-03 1.09179E-01
- 5 -1.71437E-01 1.61365E-02
- 6 -1.34392E-02 -3.07864E-02
-6 0 *********** CCCS-met-ser
- 1 -9.07193E-01 1.68373E-01
- 2 -2.88639E-01 8.65869E-01
- 3 -2.21049E-01 -1.20509E-01
- 4 -2.27648E-01 5.83930E-02
- 5 1.97080E-02 -9.41836E-02
- 6 -8.38721E-02 -4.48484E-01
-6 0 *********** CCCS-met-gln
- 1 -5.93482E-01 3.93832E-01
- 2 5.98647E-02 3.40968E-01
- 3 -1.66852E-01 6.29466E-03
- 4 -3.41352E-02 7.27062E-02
- 5 -1.35957E-01 -6.24105E-03
- 6 -2.08760E-02 -1.05664E-01
-6 0 *********** CCCS-met-asn
- 1 -7.22476E-01 1.26125E-01
- 2 -3.98561E-01 3.79292E-01
- 3 -2.21557E-01 -1.38797E-01
- 4 -1.05891E-01 5.17197E-02
- 5 -2.63333E-02 -6.16737E-02
- 6 -6.52542E-02 -2.61900E-01
-6 0 *********** CCCS-met-glu
- 1 -6.05155E-01 4.77734E-01
- 2 1.42747E-01 3.44824E-01
- 3 -1.62993E-01 4.35318E-02
- 4 -2.85344E-02 8.67631E-02
- 5 -1.28201E-01 1.95046E-05
- 6 -2.29850E-02 -7.21142E-02
-6 0 *********** CCCS-met-asp
- 1 -8.17165E-01 -9.92268E-02
- 2 -2.96896E-01 4.95997E-01
- 3 -1.73975E-01 -7.18698E-03
- 4 -1.11204E-01 4.30202E-02
- 5 -8.74157E-02 -4.95023E-02
- 6 -5.30422E-02 -2.55125E-01
-6 0 *********** CCCS-met-his
- 1 -6.69783E-01 3.41680E-01
- 2 -3.38944E-01 3.23020E-01
- 3 -3.10841E-01 -5.76625E-02
- 4 -2.76787E-02 2.02445E-02
- 5 -1.20742E-01 -3.28862E-02
- 6 -1.88590E-02 -1.19370E-01
-6 0 *********** CCCS-met-arg
- 1 -4.23522E-01 4.49574E-01
- 2 1.99695E-01 8.52442E-02
- 3 -8.89823E-03 -4.10933E-02
- 4 -4.70793E-02 9.93867E-02
- 5 -2.64343E-02 -3.90948E-02
- 6 -3.61360E-02 -7.52071E-02
-6 0 *********** CCCS-met-lys
- 1 -4.55844E-01 4.44740E-01
- 2 2.82442E-01 3.74083E-02
- 3 -3.10465E-02 -4.02216E-04
- 4 5.14216E-03 7.42740E-02
- 5 -6.77792E-02 -2.49729E-02
- 6 -5.15147E-03 -1.60042E-02
-6 0 *********** CCCS-met-pro
- 1 1.03716E+00 2.12432E-01
- 2 -8.96469E-01 -4.75144E-01
- 3 -7.25667E-01 -7.76986E-01
- 4 -2.97956E-01 4.13991E-01
- 5 2.70151E-01 1.51386E-01
- 6 -1.30370E-01 -3.52118E-01
-6 0 *********** CCCS-phe-cys
- 1 -8.75866E-01 8.02341E-01
- 2 -7.43017E-02 3.05266E-01
- 3 -2.00033E-01 -9.44923E-03
- 4 -5.31874E-02 9.53384E-02
- 5 -1.64369E-01 -1.03167E-02
- 6 -2.69415E-02 -5.62436E-02
-6 0 *********** CCCS-phe-met
- 1 -4.25798E-01 7.01409E-01
- 2 9.51487E-02 4.84016E-02
- 3 -6.42424E-02 -6.06696E-02
- 4 3.22998E-02 9.79369E-02
- 5 -1.24677E-01 -1.75984E-02
- 6 2.20636E-03 -8.00234E-03
-6 0 *********** CCCS-phe-phe
- 1 -2.70491E-01 8.60280E-01
- 2 -3.28107E-02 1.65233E-02
- 3 -6.50143E-02 -1.85787E-01
- 4 -2.37802E-02 6.99972E-02
- 5 -5.14470E-02 -3.40117E-02
- 6 -4.48839E-02 -3.33341E-02
-6 0 *********** CCCS-phe-ile
- 1 -4.32705E-01 8.93811E-01
- 2 5.99170E-02 -1.72911E-02
- 3 -1.70760E-04 -4.25378E-02
- 4 8.06998E-02 1.45841E-01
- 5 -1.77861E-01 -3.51218E-02
- 6 4.64841E-02 2.00795E-03
-6 0 *********** CCCS-phe-leu
- 1 -2.59015E-01 7.21621E-01
- 2 2.00353E-01 -1.36702E-01
- 3 1.13915E-01 -1.46197E-01
- 4 1.62792E-03 1.05742E-01
- 5 -1.57547E-02 -7.03507E-02
- 6 -6.35271E-03 -4.32138E-02
-6 0 *********** CCCS-phe-val
- 1 -3.79690E-01 8.34919E-01
- 2 6.30869E-02 -9.27999E-02
- 3 4.25173E-02 -4.87624E-02
- 4 2.78515E-02 1.52874E-01
- 5 -1.33283E-01 -5.42872E-02
- 6 2.86656E-02 -1.05697E-02
-6 0 *********** CCCS-phe-trp
- 1 -2.64689E-01 8.13134E-01
- 2 2.01594E-02 7.80805E-02
- 3 -1.01997E-01 -1.25120E-01
- 4 6.34574E-03 6.34687E-02
- 5 -8.98983E-02 -2.27110E-02
- 6 -2.22645E-02 -1.56062E-02
-6 0 *********** CCCS-phe-tyr
- 1 -2.56103E-01 8.27283E-01
- 2 -5.69698E-02 5.96913E-02
- 3 -4.92783E-02 -2.17641E-01
- 4 -7.21825E-02 9.32166E-02
- 5 4.77401E-03 -4.74386E-02
- 6 -7.84155E-02 -9.11324E-02
-6 0 *********** CCCS-phe-ala
- 1 -6.37247E-01 3.68657E-01
- 2 3.13579E-01 2.31488E-01
- 3 6.16279E-02 3.86003E-03
- 4 -1.40953E-01 1.75144E-01
- 5 8.64393E-02 -4.42932E-02
- 6 -1.02731E-01 -1.70337E-01
-6 0 *********** CCCS-phe-gly
+4 0 *********** CCCS-met-thr
+ 1 -7.50182E-01 -7.13862E-03
+ 2 -1.48158E-01 -9.85241E-02
+ 3 1.94110E-02 -7.67674E-02
+ 4 -4.58864E-02 1.16702E-02
+4 0 *********** CCCS-met-ser
+ 1 -1.07466E+00 -7.84380E-01
+ 2 2.10572E-01 1.30160E-01
+ 3 1.52089E-01 -2.05490E-01
+ 4 -2.60098E-03 2.08907E-02
+4 0 *********** CCCS-met-gln
+ 1 -7.74784E-01 -9.34274E-02
+ 2 -2.29268E-02 -1.00496E-01
+ 3 -3.94836E-02 -1.04385E-01
+ 4 -1.86197E-02 2.35040E-02
+4 0 *********** CCCS-met-asn
+ 1 -8.44036E-01 -5.57180E-01
+ 2 1.78936E-01 -2.85897E-02
+ 3 6.62377E-02 -9.25476E-02
+ 4 4.13624E-02 4.11267E-02
+4 0 *********** CCCS-met-glu
+ 1 -8.55736E-01 -3.94036E-02
+ 2 -4.11801E-02 -8.11488E-02
+ 3 -5.44869E-02 -1.09475E-01
+ 4 -1.65591E-02 1.37735E-02
+4 0 *********** CCCS-met-asp
+ 1 -9.36592E-01 -6.29915E-01
+ 2 1.82784E-01 9.07202E-03
+ 3 7.49978E-02 -1.06031E-01
+ 4 4.70710E-02 3.33531E-02
+4 0 *********** CCCS-met-his
+ 1 -8.21352E-01 -5.34210E-01
+ 2 1.69094E-01 3.83050E-03
+ 3 1.30048E-01 -7.46808E-02
+ 4 4.58805E-02 -1.08123E-02
+4 0 *********** CCCS-met-arg
+ 1 -5.77822E-01 1.50675E-01
+ 2 -1.54964E-01 6.02103E-02
+ 3 -3.15758E-02 -4.90978E-02
+ 4 -4.68353E-03 3.30582E-02
+4 0 *********** CCCS-met-lys
+ 1 -4.99865E-01 1.99580E-01
+ 2 -2.33587E-01 4.70035E-02
+ 3 1.86719E-02 -2.35417E-02
+ 4 -4.26733E-03 4.46749E-02
+4 0 *********** CCCS-met-pro
+ 1 -1.57885E+00 -5.75661E-01
+ 2 4.14501E-01 1.72252E-01
+ 3 -1.15299E-01 -4.69122E-01
+ 4 -4.85505E-02 7.85129E-02
+4 0 *********** CCCS-phe-cys
+ 1 -9.12821E-01 -3.77321E-01
+ 2 5.08327E-02 -9.85651E-02
+ 3 1.43259E-01 -1.00092E-01
+ 4 -3.00755E-02 4.69906E-02
+4 0 *********** CCCS-phe-met
+ 1 -6.23026E-01 5.94970E-02
+ 2 -1.77008E-01 -6.12113E-03
+ 3 3.13060E-02 -7.63763E-02
+ 4 -2.52265E-03 4.90769E-02
+4 0 *********** CCCS-phe-phe
+ 1 -6.64167E-01 1.14750E-01
+ 2 -9.79301E-02 1.28721E-01
+ 3 -1.13137E-01 -4.57718E-02
+ 4 5.83560E-02 4.68812E-02
+4 0 *********** CCCS-phe-ile
+ 1 -7.81793E-01 6.96795E-02
+ 2 -2.22359E-01 -3.45911E-02
+ 3 2.71752E-02 -1.44893E-01
+ 4 -2.01122E-02 5.20491E-02
+4 0 *********** CCCS-phe-leu
+ 1 -5.21894E-01 2.87467E-01
+ 2 -3.41532E-01 1.18849E-01
+ 3 -3.47587E-02 -5.97313E-02
+ 4 -9.43166E-03 6.08606E-02
+4 0 *********** CCCS-phe-val
+ 1 -6.92182E-01 1.14383E-01
+ 2 -2.74014E-01 3.81588E-03
+ 3 2.32172E-02 -1.21091E-01
+ 4 -1.19473E-02 6.27734E-02
+4 0 *********** CCCS-phe-trp
+ 1 -7.10971E-01 1.34770E-01
+ 2 -1.05461E-01 5.39577E-02
+ 3 -7.20510E-02 -6.44354E-02
+ 4 4.74478E-02 4.36588E-02
+4 0 *********** CCCS-phe-tyr
+ 1 -6.55805E-01 1.10372E-01
+ 2 -8.64232E-02 1.23200E-01
+ 3 -1.09276E-01 -4.46766E-02
+ 4 6.11438E-02 4.92978E-02
+4 0 *********** CCCS-phe-ala
+ 1 -4.94923E-01 4.12141E-02
+ 2 -3.17716E-01 -2.32467E-01
+ 3 7.38477E-02 -4.18254E-02
+ 4 -4.40483E-02 -4.39782E-02
+4 0 *********** CCCS-phe-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-phe-thr
- 1 -7.04004E-01 7.01768E-01
- 2 3.06269E-01 2.38893E-03
- 3 2.04523E-02 2.96475E-02
- 4 -4.14356E-02 1.42473E-01
- 5 -7.46043E-02 -2.53375E-02
- 6 -1.99975E-02 1.40425E-02
-6 0 *********** CCCS-phe-ser
- 1 -1.32469E+00 9.83020E-01
- 2 -6.43813E-02 6.39437E-01
- 3 -2.71913E-01 -1.61845E-02
- 4 -1.66139E-01 7.55123E-02
- 5 -9.88461E-02 -4.28548E-02
- 6 -5.04866E-02 -1.49380E-01
-6 0 *********** CCCS-phe-gln
- 1 -5.53128E-01 7.10054E-01
- 2 6.10555E-02 2.88718E-01
- 3 -1.67463E-01 -3.61561E-02
- 4 9.52812E-03 8.05631E-02
- 5 -1.41053E-01 5.82288E-04
- 6 -1.36401E-02 -5.26782E-02
-6 0 *********** CCCS-phe-asn
- 1 -9.76155E-01 4.91425E-01
- 2 -2.02354E-01 4.09462E-01
- 3 -2.89774E-01 -3.94480E-02
- 4 -7.07615E-02 4.76484E-02
- 5 -1.18713E-01 -4.26408E-02
- 6 -2.73394E-02 -1.44275E-01
-6 0 *********** CCCS-phe-glu
- 1 -5.12362E-01 8.65667E-01
- 2 6.87941E-02 2.59288E-01
- 3 -1.12944E-01 -2.73526E-02
- 4 1.76515E-02 1.00946E-01
- 5 -1.21820E-01 -1.82981E-03
- 6 -1.12696E-02 -2.95446E-02
-6 0 *********** CCCS-phe-asp
- 1 -1.29226E+00 1.87274E-01
- 2 8.66474E-02 5.02081E-01
- 3 -2.01799E-01 3.13381E-02
- 4 -9.88631E-02 9.26440E-02
- 5 -1.39372E-01 -1.57149E-03
- 6 -5.21250E-02 -1.95147E-01
-6 0 *********** CCCS-phe-his
- 1 -8.31552E-01 8.41300E-01
- 2 -3.21347E-01 3.17100E-01
- 3 -2.74849E-01 -9.16845E-04
- 4 -3.62619E-02 5.04124E-02
- 5 -1.51347E-01 -3.46561E-02
- 6 -2.06124E-02 -3.74396E-02
-6 0 *********** CCCS-phe-arg
- 1 -2.59406E-01 6.48163E-01
- 2 7.98773E-02 2.50510E-02
- 3 1.10208E-02 -1.42972E-01
- 4 -2.67348E-02 1.05750E-01
- 5 -3.11528E-02 -4.20598E-02
- 6 -4.18776E-02 -8.05745E-02
-6 0 *********** CCCS-phe-lys
- 1 -2.97664E-01 6.37126E-01
- 2 1.60797E-01 -5.88156E-02
- 3 2.10598E-03 -9.88539E-02
- 4 3.20552E-02 8.59916E-02
- 5 -9.53357E-02 -4.25523E-02
- 6 8.74750E-03 -2.68642E-02
-6 0 *********** CCCS-phe-pro
- 1 2.15341E+00 1.14340E-01
- 2 -4.88289E-01 4.75870E-01
- 3 -8.75525E-01 -4.53977E-02
- 4 -5.15634E-01 5.34940E-01
- 5 2.17152E-01 -1.25030E-01
- 6 -1.56500E-01 -6.35025E-01
-6 0 *********** CCCS-ile-cys
- 1 -5.73011E-01 2.52405E-03
- 2 -1.07437E-01 5.10441E-01
- 3 -1.75866E-01 -6.95184E-02
- 4 -1.53361E-01 1.05673E-01
- 5 -3.27841E-02 -5.95557E-02
- 6 -8.39226E-02 -3.25037E-01
-6 0 *********** CCCS-ile-met
- 1 -5.18834E-01 2.25246E-01
- 2 2.45879E-01 1.58040E-01
- 3 -1.10918E-01 1.23421E-02
- 4 -7.03527E-03 7.42941E-02
- 5 -9.96143E-02 -9.48177E-03
- 6 -1.73472E-02 -6.55431E-02
-6 0 *********** CCCS-ile-phe
- 1 -5.09094E-01 3.25674E-01
- 2 2.70363E-01 2.49135E-02
- 3 -6.44719E-02 -3.72628E-02
- 4 1.00078E-02 5.21076E-02
- 5 -8.45311E-02 -2.69845E-02
- 6 -4.43885E-03 -2.77091E-02
-6 0 *********** CCCS-ile-ile
- 1 -5.81496E-01 2.84982E-01
- 2 3.36025E-01 1.32887E-01
- 3 -1.77483E-01 7.15057E-02
- 4 6.04409E-02 5.98672E-02
- 5 -1.52115E-01 7.84380E-03
- 6 1.19657E-02 4.93603E-03
-6 0 *********** CCCS-ile-leu
- 1 -5.30792E-01 3.05216E-01
- 2 4.37190E-01 6.90465E-03
- 3 5.56775E-02 -1.00981E-02
- 4 -3.16785E-02 7.32942E-02
- 5 6.18049E-02 -3.36712E-02
- 6 -4.03159E-02 -3.42927E-02
-6 0 *********** CCCS-ile-val
- 1 -5.49509E-01 2.96691E-01
- 2 3.34550E-01 6.47504E-02
- 3 -1.27608E-01 3.64371E-02
- 4 2.38475E-02 6.44173E-02
- 5 -9.98895E-02 -3.89407E-03
- 6 -6.99273E-03 -3.24192E-03
-6 0 *********** CCCS-ile-trp
- 1 -4.74263E-01 2.94535E-01
- 2 2.33950E-01 9.58430E-02
- 3 -6.29003E-02 -3.09844E-02
- 4 -2.13975E-02 6.92349E-02
- 5 -5.85647E-02 -2.73006E-02
- 6 -2.36735E-02 -6.64104E-02
-6 0 *********** CCCS-ile-tyr
- 1 -4.79586E-01 3.12223E-01
- 2 2.27558E-01 4.36960E-02
- 3 -3.68880E-02 -6.20833E-02
- 4 -3.31701E-02 6.91398E-02
- 5 -4.22499E-02 -3.78308E-02
- 6 -2.94874E-02 -7.25669E-02
-6 0 *********** CCCS-ile-ala
- 1 -6.12077E-01 6.76544E-03
- 2 3.17361E-01 4.73605E-01
- 3 -1.04502E-01 1.62438E-02
- 4 -1.27505E-01 1.82777E-01
- 5 -7.28617E-03 -2.51552E-02
- 6 -1.07551E-01 -2.97104E-01
-6 0 *********** CCCS-ile-gly
+4 0 *********** CCCS-phe-thr
+ 1 -7.64567E-01 5.15089E-02
+ 2 -2.00158E-01 -1.03471E-01
+ 3 3.79001E-02 -1.05455E-01
+ 4 -3.12385E-02 2.81603E-02
+4 0 *********** CCCS-phe-ser
+ 1 -1.12981E+00 -7.16208E-01
+ 2 1.91507E-01 4.50295E-02
+ 3 1.90069E-01 -1.65163E-01
+ 4 -3.93849E-02 9.87696E-03
+4 0 *********** CCCS-phe-gln
+ 1 -7.94613E-01 -4.34063E-02
+ 2 -5.91753E-02 -1.15293E-01
+ 3 -2.44069E-02 -1.20060E-01
+ 4 -1.20418E-02 3.83564E-02
+4 0 *********** CCCS-phe-asn
+ 1 -8.98304E-01 -5.03805E-01
+ 2 1.72085E-01 -9.29972E-02
+ 3 9.05312E-02 -6.36999E-02
+ 4 1.59051E-02 3.47806E-02
+4 0 *********** CCCS-phe-glu
+ 1 -8.71997E-01 1.95591E-02
+ 2 -8.81181E-02 -8.83272E-02
+ 3 -4.08957E-02 -1.37569E-01
+ 4 -1.16297E-03 3.02536E-02
+4 0 *********** CCCS-phe-asp
+ 1 -9.94054E-01 -5.70525E-01
+ 2 1.72008E-01 -6.27533E-02
+ 3 1.05089E-01 -7.20248E-02
+ 4 1.66953E-02 2.56074E-02
+4 0 *********** CCCS-phe-his
+ 1 -8.75873E-01 -4.84068E-01
+ 2 1.65507E-01 -5.37154E-02
+ 3 1.55029E-01 -5.28101E-02
+ 4 1.71628E-02 -1.43560E-02
+4 0 *********** CCCS-phe-arg
+ 1 -5.76788E-01 1.88733E-01
+ 2 -1.78800E-01 8.30768E-02
+ 3 -3.94017E-02 -6.62495E-02
+ 4 2.87128E-03 2.73581E-02
+4 0 *********** CCCS-phe-lys
+ 1 -4.94552E-01 2.37310E-01
+ 2 -2.61761E-01 7.37263E-02
+ 3 1.27529E-02 -3.97466E-02
+ 4 2.80516E-03 3.62896E-02
+4 0 *********** CCCS-phe-pro
+ 1 -1.58954E+00 -4.98158E-01
+ 2 3.17655E-01 1.36275E-01
+ 3 -3.54154E-02 -4.99251E-01
+ 4 -9.54859E-02 1.19848E-01
+4 0 *********** CCCS-ile-cys
+ 1 -7.99072E-01 -5.88558E-01
+ 2 1.23647E-01 -3.55532E-03
+ 3 4.75751E-02 -8.07983E-02
+ 4 1.51485E-02 -1.48954E-03
+4 0 *********** CCCS-ile-met
+ 1 -6.12852E-01 -8.96823E-02
+ 2 -1.25015E-01 -4.06714E-02
+ 3 2.90473E-02 -1.99685E-02
+ 4 -1.74554E-02 3.34820E-02
+4 0 *********** CCCS-ile-phe
+ 1 -6.67701E-01 -3.50544E-02
+ 2 -1.10110E-01 7.16807E-02
+ 3 -5.44385E-02 -2.49255E-02
+ 4 3.62755E-02 5.45292E-02
+4 0 *********** CCCS-ile-ile
+ 1 -7.70788E-01 -1.34307E-01
+ 2 -1.27139E-01 -8.17419E-02
+ 3 2.84869E-02 -4.30272E-02
+ 4 -5.56717E-02 2.66720E-02
+4 0 *********** CCCS-ile-leu
+ 1 -5.80727E-01 1.31484E-01
+ 2 -3.01341E-01 -1.90859E-02
+ 3 3.30606E-02 -1.28841E-02
+ 4 -1.60604E-02 9.24141E-02
+4 0 *********** CCCS-ile-val
+ 1 -6.94111E-01 -7.08022E-02
+ 2 -1.94394E-01 -6.79855E-02
+ 3 3.72644E-02 -2.84876E-02
+ 4 -4.27067E-02 5.25059E-02
+4 0 *********** CCCS-ile-trp
+ 1 -7.17546E-01 -2.94128E-02
+ 2 -8.09592E-02 1.46264E-02
+ 3 -3.45915E-02 -2.71973E-02
+ 4 2.06150E-02 4.58232E-02
+4 0 *********** CCCS-ile-tyr
+ 1 -6.57428E-01 -3.53664E-02
+ 2 -9.94968E-02 7.16473E-02
+ 3 -5.42507E-02 -2.56544E-02
+ 4 3.84820E-02 5.48977E-02
+4 0 *********** CCCS-ile-ala
+ 1 -4.76455E-01 -1.00541E-01
+ 2 -1.74184E-01 -2.85022E-01
+ 3 3.73976E-02 3.22917E-02
+ 4 -7.65591E-02 -6.07851E-02
+4 0 *********** CCCS-ile-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-ile-thr
- 1 -7.20520E-01 1.52370E-01
- 2 4.47203E-01 3.06725E-01
- 3 -1.70009E-01 6.15707E-02
- 4 2.86504E-02 1.01161E-01
- 5 -1.89243E-01 1.99947E-02
- 6 2.18471E-03 -9.53606E-02
-6 0 *********** CCCS-ile-ser
- 1 -7.07592E-01 -2.08315E-01
- 2 -2.42370E-01 9.12389E-01
- 3 -2.06028E-01 -8.03538E-02
- 4 -2.46328E-01 1.14242E-01
- 5 3.63014E-02 -1.19776E-01
- 6 -1.16208E-01 -5.56712E-01
-6 0 *********** CCCS-ile-gln
- 1 -5.26889E-01 1.35829E-01
- 2 1.08716E-01 3.62910E-01
- 3 -1.49245E-01 2.90572E-02
- 4 -4.93779E-02 7.70785E-02
- 5 -1.19565E-01 -6.65903E-03
- 6 -3.08893E-02 -1.42120E-01
-6 0 *********** CCCS-ile-asn
- 1 -4.85394E-01 -1.02890E-01
- 2 -4.01240E-01 4.21931E-01
- 3 -2.38066E-01 -1.31306E-01
- 4 -1.23665E-01 6.40262E-02
- 5 -6.81329E-04 -8.44120E-02
- 6 -8.05069E-02 -3.41929E-01
-6 0 *********** CCCS-ile-glu
- 1 -5.71877E-01 1.82794E-01
- 2 2.13713E-01 3.64811E-01
- 3 -1.51832E-01 5.95781E-02
- 4 -3.44665E-02 8.61727E-02
- 5 -1.11370E-01 2.90599E-03
- 6 -3.08437E-02 -1.17011E-01
-6 0 *********** CCCS-ile-asp
- 1 -5.30826E-01 -2.23806E-01
- 2 -3.44451E-01 5.05943E-01
- 3 -2.21175E-01 -1.70086E-03
- 4 -1.05065E-01 3.92083E-02
- 5 -7.58232E-02 -6.39607E-02
- 6 -5.51117E-02 -2.89655E-01
-6 0 *********** CCCS-ile-his
- 1 -4.52130E-01 4.77438E-02
- 2 -3.06429E-01 3.64720E-01
- 3 -3.27357E-01 -2.02378E-02
- 4 -3.29100E-02 5.63917E-03
- 5 -1.37403E-01 -3.13320E-02
- 6 -6.97865E-03 -1.50268E-01
-6 0 *********** CCCS-ile-arg
- 1 -4.55087E-01 2.59936E-01
- 2 2.62757E-01 7.98537E-02
- 3 -2.06894E-02 -2.45616E-02
- 4 -3.82156E-02 8.20783E-02
- 5 -2.32183E-02 -3.41068E-02
- 6 -3.39236E-02 -7.34418E-02
-6 0 *********** CCCS-ile-lys
- 1 -4.85284E-01 2.65430E-01
- 2 3.31206E-01 4.23026E-02
- 3 -3.64308E-02 3.02512E-03
- 4 5.85108E-04 6.14099E-02
- 5 -4.68705E-02 -2.19729E-02
- 6 -1.38392E-02 -2.86941E-02
-6 0 *********** CCCS-ile-pro
- 1 6.64786E-01 3.79192E-01
- 2 -1.11100E+00 -5.06965E-01
- 3 -7.33920E-01 -7.89389E-01
- 4 -2.55024E-01 4.50527E-01
- 5 2.66792E-01 2.10900E-01
- 6 -1.43080E-01 -2.90779E-01
-6 0 *********** CCCS-leu-cys
- 1 -8.40251E-01 1.00802E-01
- 2 -8.16807E-02 4.20015E-01
- 3 -2.16289E-01 -2.06175E-02
- 4 -1.11132E-01 5.87930E-02
- 5 -9.12802E-02 -3.83205E-02
- 6 -5.20517E-02 -2.13383E-01
-6 0 *********** CCCS-leu-met
- 1 -6.63069E-01 3.77457E-01
- 2 2.12062E-01 1.23060E-01
- 3 -9.30805E-02 3.43046E-02
- 4 -1.60892E-02 8.21935E-02
- 5 -1.17614E-01 -1.09955E-02
- 6 -1.20346E-02 -2.90977E-02
-6 0 *********** CCCS-leu-phe
- 1 -6.46549E-01 5.23379E-01
- 2 1.99176E-01 1.78638E-02
- 3 -3.20141E-02 -7.43670E-02
- 4 1.56120E-02 7.30362E-02
- 5 -8.81635E-02 -3.02478E-02
- 6 -1.05236E-03 -2.87964E-02
-6 0 *********** CCCS-leu-ile
- 1 -7.53106E-01 4.91008E-01
- 2 3.01038E-01 5.96699E-02
- 3 -1.36821E-01 1.28990E-01
- 4 6.55114E-03 7.39211E-02
- 5 -1.39762E-01 7.66045E-03
- 6 -6.21255E-03 8.78048E-02
-6 0 *********** CCCS-leu-leu
- 1 -6.38289E-01 4.66345E-01
- 2 3.88354E-01 1.30425E-02
- 3 1.07787E-01 -6.10914E-03
- 4 -5.55110E-02 1.03077E-01
- 5 6.76938E-02 -4.48706E-02
- 6 -3.86635E-02 -3.86073E-02
-6 0 *********** CCCS-leu-val
- 1 -7.14354E-01 4.90254E-01
- 2 3.18672E-01 1.17585E-02
- 3 -9.85575E-02 9.25170E-02
- 4 -3.15035E-02 7.56187E-02
- 5 -8.54301E-02 -3.04924E-03
- 6 -2.68849E-02 6.21866E-02
-6 0 *********** CCCS-leu-trp
- 1 -5.91617E-01 4.79218E-01
- 2 1.55865E-01 9.49150E-02
- 3 -2.59928E-02 -6.36427E-02
- 4 -3.42631E-02 9.31772E-02
- 5 -4.73945E-02 -3.49061E-02
- 6 -2.89798E-02 -7.90483E-02
-6 0 *********** CCCS-leu-tyr
- 1 -6.09338E-01 5.04880E-01
- 2 1.52227E-01 4.22541E-02
- 3 -9.30336E-04 -1.04882E-01
- 4 -3.32304E-02 9.21869E-02
- 5 -3.72053E-02 -4.23444E-02
- 6 -3.07426E-02 -8.27124E-02
-6 0 *********** CCCS-leu-ala
- 1 -7.38767E-01 7.96087E-02
- 2 3.07720E-01 4.58239E-01
- 3 -1.11960E-01 8.02842E-02
- 4 -1.60821E-01 1.90180E-01
- 5 1.51814E-03 -1.92657E-02
- 6 -1.34659E-01 -2.40499E-01
-6 0 *********** CCCS-leu-gly
+4 0 *********** CCCS-ile-thr
+ 1 -7.47386E-01 -1.46975E-01
+ 2 -9.51584E-02 -1.29410E-01
+ 3 1.91541E-02 -1.92006E-02
+ 4 -5.86822E-02 -1.65503E-03
+4 0 *********** CCCS-ile-ser
+ 1 -9.94110E-01 -9.71102E-01
+ 2 2.52325E-01 2.10757E-01
+ 3 1.03093E-01 -2.16366E-01
+ 4 1.74220E-02 8.41007E-03
+4 0 *********** CCCS-ile-gln
+ 1 -7.57305E-01 -2.28078E-01
+ 2 2.23368E-02 -1.03830E-01
+ 3 -3.93002E-02 -6.68295E-02
+ 4 -3.18245E-02 1.14887E-02
+4 0 *********** CCCS-ile-asn
+ 1 -7.61152E-01 -7.05377E-01
+ 2 2.10926E-01 3.89055E-02
+ 3 2.44067E-02 -1.02457E-01
+ 4 5.35503E-02 3.20461E-02
+4 0 *********** CCCS-ile-glu
+ 1 -8.50983E-01 -1.89340E-01
+ 2 5.54311E-03 -9.61889E-02
+ 3 -4.10803E-02 -6.16716E-02
+ 4 -3.77471E-02 5.80756E-03
+4 0 *********** CCCS-ile-asp
+ 1 -8.52091E-01 -7.95489E-01
+ 2 2.15112E-01 8.00541E-02
+ 3 2.82425E-02 -1.16007E-01
+ 4 6.29191E-02 2.54734E-02
+4 0 *********** CCCS-ile-his
+ 1 -7.46169E-01 -6.79484E-01
+ 2 1.93835E-01 7.73916E-02
+ 3 9.23711E-02 -7.77609E-02
+ 4 5.89622E-02 -2.07259E-02
+4 0 *********** CCCS-ile-arg
+ 1 -6.03530E-01 4.49668E-02
+ 2 -1.50381E-01 1.57574E-02
+ 3 1.94766E-03 -2.86723E-02
+ 4 -9.81849E-03 3.56490E-02
+4 0 *********** CCCS-ile-lys
+ 1 -5.32611E-01 1.04805E-01
+ 2 -2.25289E-01 -1.27024E-02
+ 3 4.20610E-02 3.97173E-05
+ 4 -5.82282E-03 4.52674E-02
+4 0 *********** CCCS-ile-pro
+ 1 -1.66140E+00 -8.34673E-01
+ 2 5.62777E-01 2.67693E-01
+ 3 -1.53787E-01 -4.90724E-01
+ 4 -7.63610E-02 1.03160E-01
+4 0 *********** CCCS-leu-cys
+ 1 -8.83472E-01 -3.69309E-01
+ 2 1.30546E-01 -8.87150E-02
+ 3 1.24376E-01 -7.94938E-02
+ 4 -1.34697E-02 2.23745E-02
+4 0 *********** CCCS-leu-met
+ 1 -6.01407E-01 6.00353E-02
+ 2 -1.49399E-01 -6.36190E-02
+ 3 2.99718E-02 -6.02270E-02
+ 4 -1.27417E-02 5.22786E-02
+4 0 *********** CCCS-leu-phe
+ 1 -6.27773E-01 1.18058E-01
+ 2 -1.11521E-01 5.87123E-02
+ 3 -1.10639E-01 -4.50077E-02
+ 4 5.50946E-02 5.85454E-02
+4 0 *********** CCCS-leu-ile
+ 1 -7.59421E-01 7.79081E-02
+ 2 -1.70199E-01 -1.16861E-01
+ 3 3.22644E-02 -1.19301E-01
+ 4 -4.07583E-02 5.36117E-02
+4 0 *********** CCCS-leu-leu
+ 1 -5.18840E-01 2.89879E-01
+ 2 -3.31220E-01 8.23065E-03
+ 3 -2.64552E-02 -5.21540E-02
+ 4 -1.59381E-02 9.00404E-02
+4 0 *********** CCCS-leu-val
+ 1 -6.73797E-01 1.23189E-01
+ 2 -2.32712E-01 -8.68288E-02
+ 3 2.67392E-02 -9.91950E-02
+ 4 -3.09881E-02 7.45260E-02
+4 0 *********** CCCS-leu-trp
+ 1 -6.79078E-01 1.33816E-01
+ 2 -1.03038E-01 -9.55088E-03
+ 3 -6.76500E-02 -5.67908E-02
+ 4 3.96792E-02 5.27205E-02
+4 0 *********** CCCS-leu-tyr
+ 1 -6.19580E-01 1.12348E-01
+ 2 -1.00853E-01 5.77271E-02
+ 3 -1.06287E-01 -4.38666E-02
+ 4 5.70379E-02 6.01592E-02
+4 0 *********** CCCS-leu-ala
+ 1 -4.92916E-01 3.87462E-02
+ 2 -2.21693E-01 -2.82741E-01
+ 3 6.98050E-02 -2.62396E-02
+ 4 -6.80469E-02 -6.42838E-02
+4 0 *********** CCCS-leu-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-leu-thr
- 1 -9.44976E-01 2.81662E-01
- 2 4.57023E-01 2.69065E-01
- 3 -1.67209E-01 1.24601E-01
- 4 -1.53398E-03 8.22582E-02
- 5 -1.92059E-01 2.92207E-02
- 6 -6.80514E-03 -1.35932E-02
-6 0 *********** CCCS-leu-ser
- 1 -1.08287E+00 -2.15647E-01
- 2 -2.07611E-01 8.12190E-01
- 3 -2.28541E-01 2.00641E-02
- 4 -1.85992E-01 4.50519E-02
- 5 -7.00618E-02 -6.68383E-02
- 6 -6.21199E-02 -3.93147E-01
-6 0 *********** CCCS-leu-gln
- 1 -6.98790E-01 2.70156E-01
- 2 6.12661E-02 3.08678E-01
- 3 -1.38534E-01 4.38656E-02
- 4 -3.60664E-02 7.31595E-02
- 5 -1.48461E-01 -3.28734E-03
- 6 -1.77037E-02 -8.85479E-02
-6 0 *********** CCCS-leu-asn
- 1 -7.54994E-01 -1.16709E-01
- 2 -3.52580E-01 3.83384E-01
- 3 -2.71652E-01 -1.20290E-01
- 4 -1.15614E-01 6.27016E-03
- 5 -5.33093E-02 -5.05946E-02
- 6 -3.80107E-02 -2.60580E-01
-6 0 *********** CCCS-leu-glu
- 1 -7.53419E-01 3.56209E-01
- 2 1.53377E-01 2.96526E-01
- 3 -1.26185E-01 8.40089E-02
- 4 -4.22315E-02 9.01787E-02
- 5 -1.29072E-01 9.33139E-04
- 6 -2.31643E-02 -6.46703E-02
-6 0 *********** CCCS-leu-asp
- 1 -8.66276E-01 -3.31253E-01
- 2 -2.78418E-01 5.02737E-01
- 3 -2.69254E-01 1.77367E-02
- 4 -9.34069E-02 2.18574E-02
- 5 -1.10387E-01 -5.72619E-02
- 6 -3.09226E-02 -2.82398E-01
-6 0 *********** CCCS-leu-his
- 1 -7.43431E-01 9.36579E-02
- 2 -2.27067E-01 3.21488E-01
- 3 -3.82464E-01 -4.32883E-02
- 4 -6.49708E-02 1.42101E-02
- 5 -1.14016E-01 -4.26873E-02
- 6 -8.45458E-03 -1.53789E-01
-6 0 *********** CCCS-leu-arg
- 1 -5.52704E-01 4.13274E-01
- 2 2.09452E-01 7.23066E-02
- 3 1.45104E-02 -2.16023E-02
- 4 -4.58486E-02 1.03337E-01
- 5 -3.15514E-02 -4.09788E-02
- 6 -2.81009E-02 -7.00674E-02
-6 0 *********** CCCS-leu-lys
- 1 -5.85557E-01 4.08022E-01
- 2 2.94199E-01 3.78251E-02
- 3 -8.05245E-03 1.87303E-02
- 4 -9.35505E-03 7.69004E-02
- 5 -5.36147E-02 -2.46563E-02
- 6 -1.00591E-02 -6.38502E-03
-6 0 *********** CCCS-leu-pro
- 1 9.37267E-01 1.09257E+00
- 2 -1.28178E+00 -1.32431E-01
- 3 -8.40609E-01 -6.47204E-01
- 4 -2.62117E-01 3.61860E-01
- 5 3.22252E-01 8.87552E-02
- 6 -1.22798E-01 -2.75118E-01
-6 0 *********** CCCS-val-cys
- 1 -9.31733E-01 7.95694E-01
- 2 -1.09754E-01 2.73388E-01
- 3 -1.94723E-01 -2.57618E-02
- 4 -5.31735E-02 8.76989E-02
- 5 -1.61679E-01 -1.94824E-02
- 6 -2.07609E-02 -5.05500E-02
-6 0 *********** CCCS-val-met
- 1 -4.68807E-01 6.91549E-01
- 2 9.89204E-02 5.77414E-02
- 3 -6.82308E-02 -4.24866E-02
- 4 2.04072E-02 1.02593E-01
- 5 -1.30538E-01 -1.96040E-02
- 6 1.54853E-03 -7.85266E-03
-6 0 *********** CCCS-val-phe
- 1 -3.28219E-01 8.59353E-01
- 2 -2.46470E-02 1.72249E-02
- 3 -5.02301E-02 -1.74244E-01
- 4 -1.78072E-02 7.96368E-02
- 5 -5.19923E-02 -3.08529E-02
- 6 -4.26532E-02 -2.91724E-02
-6 0 *********** CCCS-val-ile
- 1 -4.86424E-01 8.87967E-01
- 2 6.83523E-02 -1.21687E-02
- 3 -8.91055E-03 -1.28102E-02
- 4 5.57300E-02 1.54714E-01
- 5 -1.88677E-01 -4.01679E-02
- 6 4.39675E-02 4.29683E-03
-6 0 *********** CCCS-val-leu
- 1 -3.07630E-01 7.12302E-01
- 2 2.24875E-01 -1.01911E-01
- 3 1.14643E-01 -1.07445E-01
- 4 -5.95384E-03 1.13843E-01
- 5 -4.42700E-03 -6.75108E-02
- 6 -5.53945E-03 -3.57943E-02
-6 0 *********** CCCS-val-val
- 1 -4.29242E-01 8.24832E-01
- 2 8.22405E-02 -7.97123E-02
- 3 3.27294E-02 -1.75155E-02
- 4 3.95067E-03 1.56381E-01
- 5 -1.36706E-01 -5.62789E-02
- 6 2.41571E-02 2.81685E-03
-6 0 *********** CCCS-val-trp
- 1 -3.14388E-01 8.13012E-01
- 2 1.70565E-02 8.36171E-02
- 3 -9.16184E-02 -1.18553E-01
- 4 4.45647E-03 7.18890E-02
- 5 -8.61243E-02 -2.17649E-02
- 6 -2.33130E-02 -2.14881E-02
-6 0 *********** CCCS-val-tyr
- 1 -3.12025E-01 8.26923E-01
- 2 -5.11317E-02 5.88251E-02
- 3 -3.32706E-02 -2.08271E-01
- 4 -6.58936E-02 1.02342E-01
- 5 4.60532E-03 -4.42193E-02
- 6 -7.63638E-02 -9.41839E-02
-6 0 *********** CCCS-val-ala
- 1 -6.59296E-01 3.43805E-01
- 2 3.04834E-01 2.74204E-01
- 3 2.42929E-02 1.97779E-02
- 4 -1.53481E-01 1.75727E-01
- 5 7.10213E-02 -3.60654E-02
- 6 -1.13199E-01 -1.77736E-01
-6 0 *********** CCCS-val-gly
+4 0 *********** CCCS-leu-thr
+ 1 -7.48126E-01 5.36400E-02
+ 2 -1.36944E-01 -1.66974E-01
+ 3 3.79913E-02 -8.60512E-02
+ 4 -5.13726E-02 2.28052E-02
+4 0 *********** CCCS-leu-ser
+ 1 -1.15042E+00 -7.04513E-01
+ 2 3.26201E-01 1.12553E-01
+ 3 1.49148E-01 -1.77258E-01
+ 4 1.05327E-02 1.48867E-02
+4 0 *********** CCCS-leu-gln
+ 1 -7.72562E-01 -4.87872E-02
+ 2 -4.88318E-03 -1.43881E-01
+ 3 -1.59783E-02 -1.17718E-01
+ 4 -2.80108E-02 2.86915E-02
+4 0 *********** CCCS-leu-asn
+ 1 -8.87326E-01 -5.02879E-01
+ 2 2.51793E-01 -3.85589E-02
+ 3 7.67035E-02 -6.57596E-02
+ 4 4.15438E-02 2.99316E-02
+4 0 *********** CCCS-leu-glu
+ 1 -8.47484E-01 1.78466E-02
+ 2 -3.32501E-02 -1.40402E-01
+ 3 -3.12201E-02 -1.26185E-01
+ 4 -2.13970E-02 2.31718E-02
+4 0 *********** CCCS-leu-asp
+ 1 -9.93265E-01 -5.60702E-01
+ 2 2.77596E-01 -1.04388E-02
+ 3 7.34092E-02 -7.85378E-02
+ 4 5.41183E-02 2.29368E-02
+4 0 *********** CCCS-leu-his
+ 1 -8.46472E-01 -4.84671E-01
+ 2 2.20827E-01 -1.54265E-02
+ 3 1.43643E-01 -3.01633E-02
+ 4 4.99535E-02 -2.51100E-02
+4 0 *********** CCCS-leu-arg
+ 1 -5.57785E-01 1.85912E-01
+ 2 -1.76423E-01 1.42674E-02
+ 3 -3.34123E-02 -5.84849E-02
+ 4 -1.83894E-05 3.72004E-02
+4 0 *********** CCCS-leu-lys
+ 1 -4.86399E-01 2.34143E-01
+ 2 -2.51865E-01 -3.85145E-03
+ 3 1.29808E-02 -2.60015E-02
+ 4 -1.91373E-03 5.05694E-02
+4 0 *********** CCCS-leu-pro
+ 1 -1.67903E+00 -4.70773E-01
+ 2 5.54447E-01 8.50613E-02
+ 3 -1.34828E-01 -4.71213E-01
+ 4 -2.44529E-02 7.41320E-02
+4 0 *********** CCCS-val-cys
+ 1 -8.11321E-01 -5.17223E-01
+ 2 1.51724E-01 -1.99653E-02
+ 3 6.31270E-02 -6.52135E-02
+ 4 5.14056E-03 -1.25929E-03
+4 0 *********** CCCS-val-met
+ 1 -6.01096E-01 -4.45278E-02
+ 2 -1.13496E-01 -6.61089E-02
+ 3 3.02441E-02 -2.41046E-02
+ 4 -1.84852E-02 3.38525E-02
+4 0 *********** CCCS-val-phe
+ 1 -6.42676E-01 1.42475E-02
+ 2 -1.06398E-01 4.14502E-02
+ 3 -6.27418E-02 -3.39537E-02
+ 4 3.33549E-02 5.44284E-02
+4 0 *********** CCCS-val-ile
+ 1 -7.58454E-01 -6.72337E-02
+ 2 -1.10880E-01 -1.16333E-01
+ 3 3.27005E-02 -5.39716E-02
+ 4 -5.04593E-02 2.90219E-02
+4 0 *********** CCCS-val-leu
+ 1 -5.60959E-01 1.79672E-01
+ 2 -2.92865E-01 -4.58013E-02
+ 3 1.71482E-02 -2.37541E-02
+ 4 -1.52076E-02 8.04829E-02
+4 0 *********** CCCS-val-val
+ 1 -6.80817E-01 -9.47510E-03
+ 2 -1.78723E-01 -1.00930E-01
+ 3 3.64941E-02 -4.04977E-02
+ 4 -3.93449E-02 5.11311E-02
+4 0 *********** CCCS-val-trp
+ 1 -6.93612E-01 2.05325E-02
+ 2 -7.83321E-02 -1.61338E-02
+ 3 -3.68244E-02 -3.41858E-02
+ 4 1.92010E-02 4.64430E-02
+4 0 *********** CCCS-val-tyr
+ 1 -6.32868E-01 1.15912E-02
+ 2 -9.66461E-02 4.26149E-02
+ 3 -6.11962E-02 -3.36105E-02
+ 4 3.45472E-02 5.48246E-02
+4 0 *********** CCCS-val-ala
+ 1 -4.80804E-01 -6.01286E-02
+ 2 -1.51599E-01 -2.89045E-01
+ 3 4.55108E-02 1.82308E-02
+ 4 -6.30640E-02 -5.31570E-02
+4 0 *********** CCCS-val-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-val-thr
- 1 -7.47951E-01 6.75964E-01
- 2 3.21877E-01 4.09560E-02
- 3 -1.36681E-02 6.10249E-02
- 4 -5.47045E-02 1.35170E-01
- 5 -8.81747E-02 -1.86486E-02
- 6 -2.58343E-02 2.25461E-02
-6 0 *********** CCCS-val-ser
- 1 -1.42726E+00 1.08638E+00
- 2 -2.04211E-01 5.57211E-01
- 3 -2.52679E-01 -8.66213E-02
- 4 -1.28479E-01 5.26400E-02
- 5 -1.00717E-01 -4.21256E-02
- 6 -3.41090E-02 -1.28864E-01
-6 0 *********** CCCS-val-gln
- 1 -5.90631E-01 7.02754E-01
- 2 3.32836E-02 2.86757E-01
- 3 -1.69451E-01 -3.69050E-02
- 4 5.87834E-03 8.14178E-02
- 5 -1.47893E-01 6.51650E-04
- 6 -1.36200E-02 -5.65464E-02
-6 0 *********** CCCS-val-asn
- 1 -1.01693E+00 4.69995E-01
- 2 -2.43651E-01 3.57862E-01
- 3 -2.75440E-01 -6.71032E-02
- 4 -6.00956E-02 3.50603E-02
- 5 -1.11978E-01 -4.30591E-02
- 6 -2.24426E-02 -1.33332E-01
-6 0 *********** CCCS-val-glu
- 1 -5.59980E-01 8.65508E-01
- 2 4.11141E-02 2.62655E-01
- 3 -1.22103E-01 -2.42915E-02
- 4 9.34924E-03 1.04475E-01
- 5 -1.32434E-01 -9.42781E-04
- 6 -1.35726E-02 -2.83718E-02
-6 0 *********** CCCS-val-asp
- 1 -1.31348E+00 1.44330E-01
- 2 4.79496E-02 4.85842E-01
- 3 -2.14355E-01 2.04123E-02
- 4 -8.99395E-02 6.82523E-02
- 5 -1.45692E-01 -9.49633E-03
- 6 -3.69758E-02 -1.81553E-01
-6 0 *********** CCCS-val-his
- 1 -8.99073E-01 8.53730E-01
- 2 -3.73013E-01 2.49257E-01
- 3 -2.52540E-01 -4.56975E-02
- 4 -2.56035E-02 5.33466E-02
- 5 -1.41568E-01 -3.64147E-02
- 6 -2.02090E-02 -3.58438E-02
-6 0 *********** CCCS-val-arg
- 1 -3.02527E-01 6.43574E-01
- 2 8.91040E-02 3.91895E-02
- 3 1.34633E-02 -1.18997E-01
- 4 -3.33846E-02 1.12908E-01
- 5 -3.14435E-02 -4.40267E-02
- 6 -3.86711E-02 -7.78766E-02
-6 0 *********** CCCS-val-lys
- 1 -3.39807E-01 6.29389E-01
- 2 1.75850E-01 -3.66938E-02
- 3 -1.10228E-05 -7.12032E-02
- 4 2.48918E-02 9.08821E-02
- 5 -9.22117E-02 -4.10071E-02
- 6 8.92198E-03 -1.86038E-02
-6 0 *********** CCCS-val-pro
- 1 3.21307E+00 -3.94220E-02
- 2 -2.78755E-02 1.89446E-02
- 3 -9.87983E-01 -2.92751E-01
- 4 -7.55573E-01 6.16164E-01
- 5 1.74247E-01 9.52974E-02
- 6 -8.93030E-02 -4.86632E-01
-6 0 *********** CCCS-trp-cys
- 1 -3.97134E-01 1.05061E+00
- 2 -3.85648E-03 3.02391E-01
- 3 -1.82440E-01 1.13105E-03
- 4 -3.77466E-02 9.38833E-02
- 5 -1.30142E-01 -1.04941E-02
- 6 -2.80018E-02 3.77225E-03
-6 0 *********** CCCS-trp-met
- 1 1.82023E-02 6.93022E-01
- 2 -2.85857E-03 6.82080E-02
- 3 -1.42618E-01 -1.22356E-01
- 4 2.77510E-02 4.43934E-02
- 5 -1.12740E-01 -2.48754E-02
- 6 -7.00662E-03 -1.75459E-02
-6 0 *********** CCCS-trp-phe
- 1 2.31905E-01 7.43031E-01
- 2 -1.28161E-01 1.38385E-01
- 3 -1.80478E-01 -1.48245E-01
- 4 -8.12194E-02 7.04150E-02
- 5 -5.61558E-02 -4.95481E-02
- 6 -5.20948E-02 -8.44131E-02
-6 0 *********** CCCS-trp-ile
- 1 9.75949E-02 8.35541E-01
- 2 -2.57778E-02 1.05144E-01
- 3 -1.78553E-01 -1.77678E-01
- 4 1.23933E-01 1.57000E-02
- 5 -1.50275E-01 4.01914E-03
- 6 1.32825E-02 3.38209E-03
-6 0 *********** CCCS-trp-leu
- 1 2.15784E-01 6.26957E-01
- 2 -6.18246E-02 -1.33064E-01
- 3 -1.39062E-01 -2.60829E-01
- 4 1.47643E-02 1.23307E-02
- 5 -1.42165E-01 -3.58314E-02
- 6 -3.04756E-02 -2.27094E-02
-6 0 *********** CCCS-trp-val
- 1 1.25631E-01 7.59136E-01
- 2 -8.43207E-02 4.63817E-02
- 3 -1.45060E-01 -2.05638E-01
- 4 1.03299E-01 2.86576E-02
- 5 -1.33009E-01 3.21596E-03
- 6 -5.07361E-03 -1.32676E-02
-6 0 *********** CCCS-trp-trp
- 1 1.77647E-01 7.20610E-01
- 2 -8.40165E-03 1.15882E-01
- 3 -2.17606E-01 -8.09954E-02
- 4 1.16264E-02 4.29526E-02
- 5 -1.55612E-01 -2.75210E-02
- 6 3.17444E-03 -1.44132E-02
-6 0 *********** CCCS-trp-tyr
- 1 2.24103E-01 7.14455E-01
- 2 -1.26090E-01 1.67622E-01
- 3 -1.68541E-01 -1.53912E-01
- 4 -1.12549E-01 9.01766E-02
- 5 -2.26787E-02 -6.11012E-02
- 6 -6.91377E-02 -1.23264E-01
-6 0 *********** CCCS-trp-ala
- 1 -2.67774E-01 5.54286E-01
- 2 1.62497E-01 -5.38060E-02
- 3 5.97171E-02 -1.50107E-01
- 4 -2.97727E-02 1.02047E-01
- 5 1.32197E-02 -6.16920E-02
- 6 -3.67700E-02 -8.49759E-02
-6 0 *********** CCCS-trp-gly
+4 0 *********** CCCS-val-thr
+ 1 -7.41105E-01 -8.58838E-02
+ 2 -7.65292E-02 -1.56129E-01
+ 3 2.61954E-02 -3.03294E-02
+ 4 -5.35762E-02 3.18180E-03
+4 0 *********** CCCS-val-ser
+ 1 -1.03479E+00 -8.80148E-01
+ 2 2.99630E-01 2.10209E-01
+ 3 1.08220E-01 -1.97563E-01
+ 4 1.03976E-02 1.23403E-02
+4 0 *********** CCCS-val-gln
+ 1 -7.52281E-01 -1.75271E-01
+ 2 3.61440E-02 -1.19884E-01
+ 3 -2.25685E-02 -7.45521E-02
+ 4 -3.14194E-02 1.38717E-02
+4 0 *********** CCCS-val-asn
+ 1 -7.89163E-01 -6.41908E-01
+ 2 2.38744E-01 3.99889E-02
+ 3 3.67868E-02 -8.34565E-02
+ 4 4.36729E-02 2.55220E-02
+4 0 *********** CCCS-val-glu
+ 1 -8.39244E-01 -1.26711E-01
+ 2 1.81508E-02 -1.21894E-01
+ 3 -2.83981E-02 -7.34440E-02
+ 4 -3.31335E-02 1.08919E-02
+4 0 *********** CCCS-val-asp
+ 1 -8.85374E-01 -7.18477E-01
+ 2 2.56118E-01 7.91874E-02
+ 3 3.64225E-02 -1.01706E-01
+ 4 5.26699E-02 2.33682E-02
+4 0 *********** CCCS-val-his
+ 1 -7.62378E-01 -6.17991E-01
+ 2 2.12535E-01 6.59066E-02
+ 3 9.61069E-02 -5.06113E-02
+ 4 5.03004E-02 -2.14882E-02
+4 0 *********** CCCS-val-arg
+ 1 -5.82822E-01 8.66612E-02
+ 2 -1.48760E-01 -1.05968E-02
+ 3 -3.89609E-03 -3.52453E-02
+ 4 -6.76220E-03 3.38389E-02
+4 0 *********** CCCS-val-lys
+ 1 -5.15770E-01 1.41804E-01
+ 2 -2.18761E-01 -3.71672E-02
+ 3 3.18685E-02 -4.50041E-03
+ 4 -6.12151E-03 4.17786E-02
+4 0 *********** CCCS-val-pro
+ 1 -1.69771E+00 -7.30645E-01
+ 2 6.21176E-01 2.56416E-01
+ 3 -1.48812E-01 -5.14417E-01
+ 4 -7.45039E-02 1.45455E-01
+4 0 *********** CCCS-trp-cys
+ 1 -8.77762E-01 -4.48673E-01
+ 2 1.40893E-02 -6.78055E-02
+ 3 1.30039E-01 -1.09771E-01
+ 4 -2.48853E-02 4.66347E-02
+4 0 *********** CCCS-trp-met
+ 1 -6.30061E-01 1.32246E-02
+ 2 -1.77339E-01 2.36419E-02
+ 3 3.20545E-02 -7.16448E-02
+ 4 -3.91275E-03 4.19304E-02
+4 0 *********** CCCS-trp-phe
+ 1 -6.85702E-01 6.67469E-02
+ 2 -8.95124E-02 1.59155E-01
+ 3 -9.94553E-02 -4.30629E-02
+ 4 4.97309E-02 4.48958E-02
+4 0 *********** CCCS-trp-ile
+ 1 -7.87149E-01 -4.93625E-03
+ 2 -2.22227E-01 1.19320E-02
+ 3 2.44076E-02 -1.31783E-01
+ 4 -2.27316E-02 3.93693E-02
+4 0 *********** CCCS-trp-leu
+ 1 -5.40530E-01 2.29644E-01
+ 2 -3.27799E-01 1.50827E-01
+ 3 -1.96314E-02 -4.78857E-02
+ 4 -1.73037E-02 5.22990E-02
+4 0 *********** CCCS-trp-val
+ 1 -7.01424E-01 4.61020E-02
+ 2 -2.71200E-01 4.65081E-02
+ 3 2.58690E-02 -1.07495E-01
+ 4 -1.61709E-02 4.94049E-02
+4 0 *********** CCCS-trp-trp
+ 1 -7.28796E-01 8.42478E-02
+ 2 -9.68316E-02 8.60848E-02
+ 3 -6.51644E-02 -6.08109E-02
+ 4 4.07017E-02 4.06057E-02
+4 0 *********** CCCS-trp-tyr
+ 1 -6.76477E-01 6.48958E-02
+ 2 -7.80312E-02 1.52082E-01
+ 3 -9.69848E-02 -4.24221E-02
+ 4 5.31404E-02 4.74066E-02
+4 0 *********** CCCS-trp-ala
+ 1 -4.85783E-01 -6.57016E-03
+ 2 -3.34110E-01 -2.08892E-01
+ 3 6.33967E-02 -2.88700E-02
+ 4 -3.46260E-02 -4.54350E-02
+4 0 *********** CCCS-trp-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-trp-thr
- 1 -1.33711E-01 8.17432E-01
- 2 -1.02112E-02 -9.19769E-02
- 3 4.19834E-02 -1.79869E-01
- 4 -9.29733E-03 1.05978E-01
- 5 -2.01058E-02 -4.84127E-02
- 6 -3.48484E-02 -3.62224E-02
-6 0 *********** CCCS-trp-ser
- 1 -6.89338E-01 1.52558E+00
- 2 1.70338E-03 5.33969E-01
- 3 -1.21646E-01 -4.78040E-02
- 4 -3.17402E-01 2.32192E-01
- 5 9.22405E-02 -7.06805E-02
- 6 -1.87593E-01 -1.64748E-01
-6 0 *********** CCCS-trp-gln
- 1 -1.12832E-01 7.85502E-01
- 2 9.54529E-02 2.06424E-01
- 3 -1.28797E-01 -2.71431E-02
- 4 -4.92651E-02 8.04872E-02
- 5 -7.21551E-02 -3.04355E-02
- 6 -3.21518E-02 -3.10111E-02
-6 0 *********** CCCS-trp-asn
- 1 -6.86239E-01 8.42747E-01
- 2 2.69186E-02 4.03207E-01
- 3 -1.94512E-01 6.01381E-02
- 4 -1.02355E-01 8.87088E-02
- 5 -1.26219E-01 -1.27314E-02
- 6 -4.63795E-02 -3.84224E-02
-6 0 *********** CCCS-trp-glu
- 1 1.44529E-02 9.00922E-01
- 2 7.20218E-02 2.08210E-01
- 3 -1.08150E-01 -6.56768E-02
- 4 -3.40755E-02 7.66866E-02
- 5 -6.10424E-02 -3.39727E-02
- 6 -2.86226E-02 -3.32357E-02
-6 0 *********** CCCS-trp-asp
- 1 -1.02470E+00 7.22539E-01
- 2 2.12162E-01 2.74323E-01
- 3 -4.62482E-02 -2.96736E-02
- 4 -1.77971E-01 1.60746E-01
- 5 5.32729E-02 -4.00140E-02
- 6 -1.18745E-01 -1.35881E-01
-6 0 *********** CCCS-trp-his
- 1 -4.22600E-01 1.06516E+00
- 2 -1.05595E-01 5.03339E-01
- 3 -2.42471E-01 1.75686E-02
- 4 -6.37491E-02 7.36291E-02
- 5 -1.68057E-01 -1.00104E-02
- 6 -2.17606E-02 -4.53861E-02
-6 0 *********** CCCS-trp-arg
- 1 1.47244E-01 5.70904E-01
- 2 -4.13970E-02 4.66966E-02
- 3 -1.21413E-01 -1.84092E-01
- 4 -5.57780E-02 5.98553E-02
- 5 -4.10924E-02 -4.84950E-02
- 6 -5.42543E-02 -9.47073E-02
-6 0 *********** CCCS-trp-lys
- 1 1.13950E-01 5.69648E-01
- 2 -1.84162E-02 -4.75211E-02
- 3 -1.56160E-01 -1.82586E-01
- 4 2.97052E-02 2.50834E-02
- 5 -1.35742E-01 -2.73430E-02
- 6 -1.16050E-02 -2.35796E-02
-6 0 *********** CCCS-trp-pro
- 1 2.23324E+00 -1.42887E+00
- 2 3.07739E-01 1.78965E-01
- 3 -2.86215E-01 1.28548E-02
- 4 -9.97448E-02 6.25659E-01
- 5 3.17447E-01 -1.17601E-01
- 6 -1.94426E-01 -8.11239E-01
-6 0 *********** CCCS-tyr-cys
- 1 -8.74910E-01 8.12394E-01
- 2 -7.70954E-02 3.01194E-01
- 3 -1.99725E-01 -1.16268E-02
- 4 -5.14576E-02 9.50848E-02
- 5 -1.64644E-01 -1.04927E-02
- 6 -2.62137E-02 -4.41084E-02
-6 0 *********** CCCS-tyr-met
- 1 -4.21087E-01 7.03401E-01
- 2 9.26359E-02 4.87118E-02
- 3 -6.54305E-02 -6.12420E-02
- 4 3.22947E-02 9.75565E-02
- 5 -1.24815E-01 -1.75518E-02
- 6 2.02043E-03 -1.58925E-02
-6 0 *********** CCCS-tyr-phe
- 1 -2.64457E-01 8.61701E-01
- 2 -3.63555E-02 1.83615E-02
- 3 -6.58356E-02 -1.85778E-01
- 4 -2.41505E-02 7.04592E-02
- 5 -5.10864E-02 -3.38210E-02
- 6 -4.53203E-02 -3.36515E-02
-6 0 *********** CCCS-tyr-ile
- 1 -4.26569E-01 8.95743E-01
- 2 5.63556E-02 -1.49566E-02
- 3 -2.37221E-03 -4.50355E-02
- 4 8.15204E-02 1.45289E-01
- 5 -1.78474E-01 -3.41528E-02
- 6 4.58348E-02 1.18181E-04
-6 0 *********** CCCS-tyr-leu
- 1 -2.53351E-01 7.22150E-01
- 2 1.96335E-01 -1.35416E-01
- 3 1.10728E-01 -1.45961E-01
- 4 2.26006E-03 1.05097E-01
- 5 -1.74685E-02 -6.96317E-02
- 6 -6.34319E-03 -4.24044E-02
-6 0 *********** CCCS-tyr-val
- 1 -3.73573E-01 8.35714E-01
- 2 5.96991E-02 -9.02958E-02
- 3 4.04047E-02 -5.07499E-02
- 4 2.90275E-02 1.52315E-01
- 5 -1.34453E-01 -5.36123E-02
- 6 2.86081E-02 -8.52329E-03
-6 0 *********** CCCS-tyr-trp
- 1 -2.59607E-01 8.14954E-01
- 2 1.78745E-02 7.89787E-02
- 3 -1.03772E-01 -1.24602E-01
- 4 6.81744E-03 6.32072E-02
- 5 -9.08015E-02 -2.25481E-02
- 6 -2.18776E-02 -1.78094E-02
-6 0 *********** CCCS-tyr-tyr
- 1 -2.50521E-01 8.28663E-01
- 2 -5.99588E-02 6.13240E-02
- 3 -5.03925E-02 -2.17278E-01
- 4 -7.22479E-02 9.34489E-02
- 5 4.84293E-03 -4.72076E-02
- 6 -7.85830E-02 -9.20778E-02
-6 0 *********** CCCS-tyr-ala
- 1 -6.33522E-01 3.71638E-01
- 2 3.11053E-01 2.28452E-01
- 3 6.05647E-02 1.78918E-03
- 4 -1.39879E-01 1.74405E-01
- 5 8.54206E-02 -4.45713E-02
- 6 -1.01848E-01 -1.69962E-01
-6 0 *********** CCCS-tyr-gly
+4 0 *********** CCCS-trp-thr
+ 1 -7.62215E-01 -1.66209E-02
+ 2 -2.05828E-01 -6.25774E-02
+ 3 3.09343E-02 -9.31738E-02
+ 4 -2.80790E-02 1.68598E-02
+4 0 *********** CCCS-trp-ser
+ 1 -1.03154E+00 -7.94259E-01
+ 2 1.02630E-01 4.54645E-02
+ 3 1.91038E-01 -1.62561E-01
+ 4 -3.94659E-02 3.14862E-03
+4 0 *********** CCCS-trp-gln
+ 1 -7.87206E-01 -9.82181E-02
+ 2 -7.02570E-02 -8.76610E-02
+ 3 -3.43813E-02 -1.09824E-01
+ 4 -7.50564E-03 3.42076E-02
+4 0 *********** CCCS-trp-asn
+ 1 -8.38710E-01 -5.63729E-01
+ 2 1.18971E-01 -8.41619E-02
+ 3 8.62810E-02 -7.55688E-02
+ 4 1.21475E-02 4.06533E-02
+4 0 *********** CCCS-trp-glu
+ 1 -8.70081E-01 -4.81074E-02
+ 2 -9.38332E-02 -4.96216E-02
+ 3 -4.83154E-02 -1.25695E-01
+ 4 1.54378E-04 2.43171E-02
+4 0 *********** CCCS-trp-asp
+ 1 -9.21223E-01 -6.43630E-01
+ 2 1.00987E-01 -4.96197E-02
+ 3 1.07722E-01 -8.08610E-02
+ 4 1.17774E-02 2.99547E-02
+4 0 *********** CCCS-trp-his
+ 1 -8.31417E-01 -5.39018E-01
+ 2 1.27308E-01 -3.60611E-02
+ 3 1.50432E-01 -7.61718E-02
+ 4 1.07643E-02 -5.57927E-03
+4 0 *********** CCCS-trp-arg
+ 1 -5.93732E-01 1.45068E-01
+ 2 -1.68473E-01 1.09384E-01
+ 3 -3.23216E-02 -6.11325E-02
+ 4 -2.80306E-03 2.38843E-02
+4 0 *********** CCCS-trp-lys
+ 1 -5.08905E-01 1.95584E-01
+ 2 -2.53051E-01 9.98052E-02
+ 3 2.09620E-02 -3.54569E-02
+ 4 -2.35324E-03 2.99840E-02
+4 0 *********** CCCS-trp-pro
+ 1 -1.44668E+00 -5.89494E-01
+ 2 1.83382E-01 1.54639E-01
+ 3 -5.66479E-03 -4.45790E-01
+ 4 -9.42532E-02 7.55533E-02
+4 0 *********** CCCS-tyr-cys
+ 1 -9.09006E-01 -3.79759E-01
+ 2 4.91124E-02 -9.52209E-02
+ 3 1.43726E-01 -1.01207E-01
+ 4 -2.96906E-02 4.71193E-02
+4 0 *********** CCCS-tyr-met
+ 1 -6.22207E-01 5.78449E-02
+ 2 -1.75559E-01 -5.22250E-03
+ 3 3.06699E-02 -7.62937E-02
+ 4 -2.83009E-03 4.88203E-02
+4 0 *********** CCCS-tyr-phe
+ 1 -6.63789E-01 1.13326E-01
+ 2 -9.63951E-02 1.28701E-01
+ 3 -1.13383E-01 -4.57057E-02
+ 4 5.77765E-02 4.72835E-02
+4 0 *********** CCCS-tyr-ile
+ 1 -7.80595E-01 6.65728E-02
+ 2 -2.19900E-01 -3.24672E-02
+ 3 2.60002E-02 -1.44710E-01
+ 4 -2.05834E-02 5.11673E-02
+4 0 *********** CCCS-tyr-leu
+ 1 -5.21881E-01 2.84544E-01
+ 2 -3.38132E-01 1.18754E-01
+ 3 -3.51877E-02 -5.87236E-02
+ 4 -1.08133E-02 6.11789E-02
+4 0 *********** CCCS-tyr-val
+ 1 -6.91368E-01 1.11588E-01
+ 2 -2.71285E-01 5.22627E-03
+ 3 2.21618E-02 -1.20641E-01
+ 4 -1.27789E-02 6.21999E-02
+4 0 *********** CCCS-tyr-trp
+ 1 -7.10331E-01 1.32960E-01
+ 2 -1.03873E-01 5.44967E-02
+ 3 -7.25142E-02 -6.43234E-02
+ 4 4.69414E-02 4.37841E-02
+4 0 *********** CCCS-tyr-tyr
+ 1 -6.55384E-01 1.09023E-01
+ 2 -8.50300E-02 1.23183E-01
+ 3 -1.09497E-01 -4.46240E-02
+ 4 6.06009E-02 4.96820E-02
+4 0 *********** CCCS-tyr-ala
+ 1 -4.93753E-01 3.88784E-02
+ 2 -3.15706E-01 -2.29990E-01
+ 3 7.28305E-02 -4.18762E-02
+ 4 -4.38649E-02 -4.54387E-02
+4 0 *********** CCCS-tyr-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-tyr-thr
- 1 -6.96774E-01 7.05012E-01
- 2 3.00191E-01 8.08979E-04
- 3 2.16170E-02 2.79656E-02
- 4 -4.32462E-02 1.42628E-01
- 5 -7.21369E-02 -2.67662E-02
- 6 -2.07074E-02 4.98846E-03
-6 0 *********** CCCS-tyr-ser
- 1 -1.32920E+00 1.01674E+00
- 2 -7.69095E-02 6.26341E-01
- 3 -2.68708E-01 -2.52823E-02
- 4 -1.65000E-01 7.64946E-02
- 5 -9.52082E-02 -4.46636E-02
- 6 -5.10471E-02 -1.47506E-01
-6 0 *********** CCCS-tyr-gln
- 1 -5.49194E-01 7.14487E-01
- 2 5.95044E-02 2.87362E-01
- 3 -1.68381E-01 -3.66365E-02
- 4 8.95640E-03 8.01203E-02
- 5 -1.40299E-01 3.72645E-04
- 6 -1.39944E-02 -5.22733E-02
-6 0 *********** CCCS-tyr-asn
- 1 -9.78500E-01 4.99941E-01
- 2 -2.01265E-01 4.05049E-01
- 3 -2.88032E-01 -3.96732E-02
- 4 -6.91792E-02 4.65139E-02
- 5 -1.18774E-01 -4.22230E-02
- 6 -2.69835E-02 -1.32417E-01
-6 0 *********** CCCS-tyr-glu
- 1 -5.07025E-01 8.71111E-01
- 2 6.53347E-02 2.58831E-01
- 3 -1.14301E-01 -2.89383E-02
- 4 1.71746E-02 1.00381E-01
- 5 -1.21433E-01 -1.63917E-03
- 6 -1.20017E-02 -2.37310E-02
-6 0 *********** CCCS-tyr-asp
- 1 -1.29545E+00 1.96747E-01
- 2 9.02428E-02 4.96857E-01
- 3 -2.01190E-01 2.93247E-02
- 4 -9.95175E-02 9.23017E-02
- 5 -1.36887E-01 -2.51745E-03
- 6 -5.21902E-02 -1.94364E-01
-6 0 *********** CCCS-tyr-his
- 1 -8.32839E-01 8.53486E-01
- 2 -3.26148E-01 3.13931E-01
- 3 -2.71164E-01 -5.87415E-03
- 4 -3.39861E-02 5.05028E-02
- 5 -1.52008E-01 -3.40467E-02
- 6 -2.00727E-02 -2.71200E-02
-6 0 *********** CCCS-tyr-arg
- 1 -2.54799E-01 6.48923E-01
- 2 7.74452E-02 2.60184E-02
- 3 9.31987E-03 -1.43055E-01
- 4 -2.70483E-02 1.05449E-01
- 5 -3.09097E-02 -4.19048E-02
- 6 -4.21302E-02 -8.15534E-02
-6 0 *********** CCCS-tyr-lys
- 1 -2.92966E-01 6.37739E-01
- 2 1.57946E-01 -5.78773E-02
- 3 6.54551E-05 -9.91841E-02
- 4 3.22857E-02 8.56176E-02
- 5 -9.58168E-02 -4.21040E-02
- 6 8.52339E-03 -1.65671E-02
-6 0 *********** CCCS-tyr-pro
- 1 2.22771E+00 9.52366E-02
- 2 -4.27668E-01 4.71305E-01
- 3 -8.63619E-01 -2.87620E-02
- 4 -5.28150E-01 5.68096E-01
- 5 1.99111E-01 -9.44542E-02
- 6 -1.62728E-01 -6.03297E-01
-6 0 *********** CCCS-ala-cys
- 1 2.09544E-01 1.51086E-01
- 2 -9.32640E-02 3.53246E-01
- 3 -1.87861E-01 -6.81242E-02
- 4 -1.58488E-01 1.78597E-01
- 5 2.36952E-02 -7.92151E-02
- 6 -1.16908E-01 -3.11933E-01
-6 0 *********** CCCS-ala-met
- 1 8.08658E-02 -7.98845E-02
- 2 1.64198E-01 2.11674E-01
- 3 -8.33974E-02 -2.40838E-02
- 4 -1.18256E-02 7.36953E-02
- 5 -6.02118E-02 -2.57788E-02
- 6 -2.91481E-02 -1.67912E-01
-6 0 *********** CCCS-ala-phe
- 1 6.94077E-02 -1.24168E-01
- 2 2.75029E-01 1.36820E-01
- 3 -8.70868E-02 -5.18404E-02
- 4 5.45502E-03 4.56749E-02
- 5 -7.55886E-02 -2.66537E-02
- 6 -1.60765E-02 -1.43502E-01
-6 0 *********** CCCS-ala-ile
- 1 6.57519E-02 -7.54499E-02
- 2 2.54933E-01 1.69169E-01
- 3 -1.54127E-01 4.20736E-02
- 4 1.42866E-01 2.85581E-02
- 5 -1.94794E-01 7.37758E-03
- 6 5.80261E-02 -5.91508E-02
-6 0 *********** CCCS-ala-leu
- 1 1.70521E-02 -1.52559E-01
- 2 3.69633E-01 1.81837E-01
- 3 -6.35927E-02 -2.82942E-02
- 4 7.09564E-02 3.26750E-02
- 5 -9.74730E-02 -8.68669E-03
- 6 2.06930E-02 -1.32808E-01
-6 0 *********** CCCS-ala-val
- 1 7.94939E-02 -1.19920E-01
- 2 2.26859E-01 1.78737E-01
- 3 -5.23242E-02 -2.45068E-02
- 4 1.92040E-02 7.36224E-02
- 5 -5.15181E-02 -1.95582E-02
- 6 -1.61085E-02 -1.56407E-01
-6 0 *********** CCCS-ala-trp
- 1 5.02124E-02 -1.02579E-01
- 2 2.69417E-01 1.26043E-01
- 3 -1.46006E-01 -6.62372E-03
- 4 7.47036E-02 2.14196E-02
- 5 -1.60095E-01 -8.58666E-03
- 6 2.64333E-02 -8.68919E-02
-6 0 *********** CCCS-ala-tyr
- 1 6.63612E-02 -1.23359E-01
- 2 2.61873E-01 1.32742E-01
- 3 -8.79662E-02 -5.78034E-02
- 4 -5.16327E-03 4.88838E-02
- 5 -6.94572E-02 -2.97959E-02
- 6 -2.23449E-02 -1.52417E-01
-6 0 *********** CCCS-ala-ala
- 1 8.51209E-02 -2.47944E-02
- 2 5.07424E-02 3.52086E-01
- 3 -1.00328E-01 4.72799E-02
- 4 -2.70699E-02 1.01296E-01
- 5 -7.57268E-02 -2.21811E-02
- 6 -4.67199E-02 -1.83470E-01
-6 0 *********** CCCS-ala-gly
+4 0 *********** CCCS-tyr-thr
+ 1 -7.63070E-01 4.85054E-02
+ 2 -1.98173E-01 -1.00968E-01
+ 3 3.67143E-02 -1.05619E-01
+ 4 -3.12982E-02 2.71395E-02
+4 0 *********** CCCS-tyr-ser
+ 1 -1.12069E+00 -7.18785E-01
+ 2 1.83787E-01 4.83379E-02
+ 3 1.94718E-01 -1.64962E-01
+ 4 -4.05226E-02 9.58595E-03
+4 0 *********** CCCS-tyr-gln
+ 1 -7.92835E-01 -4.56580E-02
+ 2 -5.84674E-02 -1.12935E-01
+ 3 -2.47702E-02 -1.20699E-01
+ 4 -1.19943E-02 3.78514E-02
+4 0 *********** CCCS-tyr-asn
+ 1 -8.92656E-01 -5.05654E-01
+ 2 1.67840E-01 -9.02306E-02
+ 3 9.28662E-02 -6.45290E-02
+ 4 1.52571E-02 3.55943E-02
+4 0 *********** CCCS-tyr-glu
+ 1 -8.70245E-01 1.66227E-02
+ 2 -8.67099E-02 -8.56785E-02
+ 3 -4.16259E-02 -1.38101E-01
+ 4 -1.21162E-03 2.96354E-02
+4 0 *********** CCCS-tyr-asp
+ 1 -9.87024E-01 -5.72803E-01
+ 2 1.66527E-01 -5.94872E-02
+ 3 1.08314E-01 -7.30065E-02
+ 4 1.55906E-02 2.64798E-02
+4 0 *********** CCCS-tyr-his
+ 1 -8.70789E-01 -4.85639E-01
+ 2 1.61844E-01 -5.15013E-02
+ 3 1.56654E-01 -5.32494E-02
+ 4 1.71858E-02 -1.36583E-02
+4 0 *********** CCCS-tyr-arg
+ 1 -5.76451E-01 1.86974E-01
+ 2 -1.77028E-01 8.31900E-02
+ 3 -3.97542E-02 -6.58250E-02
+ 4 2.32992E-03 2.74026E-02
+4 0 *********** CCCS-tyr-lys
+ 1 -4.94302E-01 2.35360E-01
+ 2 -2.59575E-01 7.37574E-02
+ 3 1.22432E-02 -3.91132E-02
+ 4 2.12332E-03 3.63422E-02
+4 0 *********** CCCS-tyr-pro
+ 1 -1.57814E+00 -5.05783E-01
+ 2 3.10335E-01 1.45772E-01
+ 3 -2.88148E-02 -5.03989E-01
+ 4 -9.96755E-02 1.20665E-01
+4 0 *********** CCCS-ala-cys
+ 1 -8.23119E-01 -2.98213E-01
+ 2 1.01944E-01 -3.12124E-02
+ 3 1.11175E-01 -1.12750E-01
+ 4 8.21128E-03 2.89820E-02
+4 0 *********** CCCS-ala-met
+ 1 -5.58872E-01 1.00798E-01
+ 2 -9.75431E-02 -3.76572E-02
+ 3 -8.93879E-04 -6.04168E-02
+ 4 -5.95098E-03 4.35541E-02
+4 0 *********** CCCS-ala-phe
+ 1 -5.82985E-01 1.69299E-01
+ 2 -4.93783E-02 4.21883E-02
+ 3 -1.23128E-01 -2.01764E-02
+ 4 5.47857E-02 4.91434E-02
+4 0 *********** CCCS-ala-ile
+ 1 -7.07307E-01 1.12039E-01
+ 2 -9.73446E-02 -6.42191E-02
+ 3 -1.97691E-02 -1.14987E-01
+ 4 -3.33150E-02 3.53489E-02
+4 0 *********** CCCS-ala-leu
+ 1 -4.77868E-01 2.92749E-01
+ 2 -2.15940E-01 2.53932E-02
+ 3 -5.38848E-02 -2.48878E-02
+ 4 -2.48870E-02 8.98947E-02
+4 0 *********** CCCS-ala-val
+ 1 -6.27675E-01 1.52286E-01
+ 2 -1.45924E-01 -4.27431E-02
+ 3 -2.12772E-02 -9.07665E-02
+ 4 -2.87085E-02 5.83967E-02
+4 0 *********** CCCS-ala-trp
+ 1 -6.25869E-01 1.79848E-01
+ 2 -5.04153E-02 -8.97269E-03
+ 3 -8.73481E-02 -3.76793E-02
+ 4 3.99514E-02 3.98532E-02
+4 0 *********** CCCS-ala-tyr
+ 1 -5.73991E-01 1.63445E-01
+ 2 -4.37848E-02 4.09536E-02
+ 3 -1.17701E-01 -2.02245E-02
+ 4 5.77646E-02 5.01472E-02
+4 0 *********** CCCS-ala-ala
+ 1 -4.56331E-01 4.60183E-02
+ 2 -1.76124E-01 -1.66119E-01
+ 3 4.46991E-02 -4.74663E-02
+ 4 -5.96800E-02 -5.29220E-02
+4 0 *********** CCCS-ala-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-ala-thr
- 1 1.13047E-01 -1.23960E-02
- 2 2.18880E-01 2.98764E-01
- 3 -1.51347E-01 1.03076E-01
- 4 7.51537E-02 5.26880E-02
- 5 -2.09815E-01 1.72523E-02
- 6 2.60870E-02 -7.22198E-02
-6 0 *********** CCCS-ala-ser
- 1 2.81029E-01 3.00033E-01
- 2 -2.10672E-01 6.34637E-01
- 3 -3.04209E-01 -1.43905E-01
- 4 -2.63362E-01 2.75132E-01
- 5 1.41483E-01 -1.59470E-01
- 6 -1.80790E-01 -5.44148E-01
-6 0 *********** CCCS-ala-gln
- 1 1.57779E-01 2.41022E-03
- 2 3.10357E-02 2.98564E-01
- 3 -1.28707E-01 -1.55013E-02
- 4 -6.15053E-02 1.03456E-01
- 5 -3.84837E-02 -4.39229E-02
- 6 -6.01907E-02 -2.12940E-01
-6 0 *********** CCCS-ala-asn
- 1 1.70297E-01 3.18618E-01
- 2 -2.30254E-01 2.49968E-01
- 3 -2.35872E-01 -1.73680E-01
- 4 -1.89383E-01 1.70956E-01
- 5 5.05196E-02 -9.24758E-02
- 6 -1.17843E-01 -3.08245E-01
-6 0 *********** CCCS-ala-glu
- 1 1.84988E-01 -2.89421E-02
- 2 8.40119E-02 3.20125E-01
- 3 -1.05228E-01 1.72245E-02
- 4 -2.42931E-02 9.53286E-02
- 5 -5.62194E-02 -2.89932E-02
- 6 -4.07861E-02 -1.93078E-01
-6 0 *********** CCCS-ala-asp
- 1 2.11813E-01 3.53614E-01
- 2 -2.65496E-01 3.04920E-01
- 3 -2.52910E-01 -9.99053E-02
- 4 -1.49552E-01 1.54690E-01
- 5 6.21563E-03 -6.88708E-02
- 6 -1.02592E-01 -2.53131E-01
-6 0 *********** CCCS-ala-his
- 1 2.34307E-01 2.85648E-01
- 2 -1.90718E-01 1.70237E-01
- 3 -2.53326E-01 -2.73589E-02
- 4 -7.61866E-02 1.13211E-01
- 5 -1.00401E-01 -2.25034E-02
- 6 -4.82999E-02 -1.17152E-01
-6 0 *********** CCCS-ala-arg
- 1 2.97079E-02 -1.31641E-01
- 2 2.32455E-01 1.76777E-01
- 3 -6.79132E-02 -5.56482E-02
- 4 -4.60863E-03 5.79520E-02
- 5 -5.01631E-02 -3.06966E-02
- 6 -2.55406E-02 -1.71339E-01
-6 0 *********** CCCS-ala-lys
- 1 1.04076E-02 -1.25139E-01
- 2 2.67193E-01 1.66676E-01
- 3 -8.10161E-02 -2.95132E-02
- 4 3.72983E-02 4.05951E-02
- 5 -9.00418E-02 -1.61797E-02
- 6 1.52228E-03 -1.32515E-01
-6 0 *********** CCCS-ala-pro
- 1 6.87749E-02 -9.39532E-01
- 2 -2.71845E-01 -6.79470E-01
- 3 -2.48730E-01 -4.40063E-01
- 4 -3.25926E-01 2.86940E-01
- 5 1.25922E-01 -2.21273E-01
- 6 -2.08755E-01 -5.38499E-01
-6 0 *********** CCCS-gly-cys
- 1 6.01435E-01 1.80977E-01
- 2 1.74454E-01 1.74251E-01
- 3 -9.03909E-02 -1.95994E-01
- 4 -1.35065E-01 9.16175E-02
- 5 -8.46503E-03 -5.52195E-02
- 6 -9.19744E-02 -2.34320E-01
-6 0 *********** CCCS-gly-met
- 1 3.53993E-01 -1.75955E-01
- 2 1.29616E-01 5.95656E-02
- 3 -1.50906E-01 -2.04218E-02
- 4 -3.24127E-02 7.64497E-02
- 5 -8.97846E-02 -2.82295E-02
- 6 -2.99701E-02 -1.35507E-01
-6 0 *********** CCCS-gly-phe
- 1 3.51795E-01 -2.84766E-01
- 2 1.62590E-01 5.93443E-02
- 3 -7.08266E-02 5.41716E-03
- 4 -2.88027E-03 8.09942E-02
- 5 -5.90019E-02 -3.11981E-02
- 6 -1.82615E-02 -1.44434E-01
-6 0 *********** CCCS-gly-ile
- 1 3.81749E-01 -2.29510E-01
- 2 2.01331E-01 -2.61401E-02
- 3 -2.48470E-01 4.44326E-03
- 4 9.80798E-02 5.05726E-02
- 5 -1.75030E-01 6.46738E-04
- 6 3.83858E-02 -6.40724E-02
-6 0 *********** CCCS-gly-leu
- 1 2.66112E-01 -3.35984E-01
- 2 1.23816E-01 7.72979E-02
- 3 -1.46219E-01 1.00603E-01
- 4 3.51830E-02 4.00618E-02
- 5 -2.08323E-01 -1.01636E-03
- 6 1.91208E-02 -5.76509E-02
-6 0 *********** CCCS-gly-val
- 1 3.52084E-01 -2.67382E-01
- 2 1.51180E-01 2.98225E-02
- 3 -1.42671E-01 -2.62835E-02
- 4 -1.13435E-03 8.19561E-02
- 5 -9.66041E-02 -3.18810E-03
- 6 -2.16153E-02 -1.28410E-01
-6 0 *********** CCCS-gly-trp
- 1 3.20821E-01 -2.55603E-01
- 2 1.99437E-01 -8.94510E-03
- 3 -1.80656E-01 3.67239E-02
- 4 9.62791E-02 2.31220E-02
- 5 -1.89895E-01 -1.62191E-02
- 6 3.33412E-02 -5.07471E-02
-6 0 *********** CCCS-gly-tyr
- 1 3.42685E-01 -2.75664E-01
- 2 1.63606E-01 5.62233E-02
- 3 -7.01064E-02 9.02606E-04
- 4 -3.54681E-03 7.64142E-02
- 5 -6.40909E-02 -3.04437E-02
- 6 -2.14171E-02 -1.42291E-01
-6 0 *********** CCCS-gly-ala
- 1 3.03649E-01 -1.03199E-02
- 2 1.70126E-02 1.19360E-01
- 3 -2.95039E-01 4.62437E-03
- 4 6.86487E-04 3.52072E-02
- 5 -1.18686E-01 -4.74139E-02
- 6 -2.58228E-02 -1.03776E-01
-6 0 *********** CCCS-gly-gly
+4 0 *********** CCCS-ala-thr
+ 1 -6.95288E-01 8.55479E-02
+ 2 -8.20308E-02 -1.00411E-01
+ 3 -5.82995E-03 -9.47505E-02
+ 4 -4.27445E-02 1.02087E-02
+4 0 *********** CCCS-ala-ser
+ 1 -1.00835E+00 -5.95504E-01
+ 2 1.93668E-01 1.39001E-01
+ 3 1.94025E-01 -1.73473E-01
+ 4 -1.09209E-03 6.13657E-03
+4 0 *********** CCCS-ala-gln
+ 1 -7.19265E-01 -1.05762E-03
+ 2 1.15061E-02 -9.06152E-02
+ 3 -3.77212E-02 -1.21326E-01
+ 4 -1.76413E-02 1.76405E-02
+4 0 *********** CCCS-ala-asn
+ 1 -8.10659E-01 -4.23361E-01
+ 2 1.67923E-01 1.70979E-03
+ 3 1.05131E-01 -8.22832E-02
+ 4 3.91616E-02 3.28299E-02
+4 0 *********** CCCS-ala-glu
+ 1 -7.84610E-01 6.15637E-02
+ 2 1.32832E-03 -8.67880E-02
+ 3 -6.37268E-02 -1.23711E-01
+ 4 -1.43390E-02 7.42007E-03
+4 0 *********** CCCS-ala-asp
+ 1 -8.93182E-01 -4.73106E-01
+ 2 1.79835E-01 3.43482E-02
+ 3 1.14421E-01 -9.97471E-02
+ 4 4.01887E-02 2.70028E-02
+4 0 *********** CCCS-ala-his
+ 1 -7.73834E-01 -4.02384E-01
+ 2 1.48911E-01 7.25476E-03
+ 3 1.51588E-01 -4.98250E-02
+ 4 5.04625E-02 -1.63792E-02
+4 0 *********** CCCS-ala-arg
+ 1 -5.12065E-01 2.16366E-01
+ 2 -1.12670E-01 1.55364E-02
+ 3 -5.43212E-02 -3.82911E-02
+ 4 -3.41771E-03 3.40400E-02
+4 0 *********** CCCS-ala-lys
+ 1 -4.43114E-01 2.49535E-01
+ 2 -1.72275E-01 9.35242E-03
+ 3 -1.23287E-02 -1.35432E-02
+ 4 -5.90737E-03 4.85906E-02
+4 0 *********** CCCS-ala-pro
+ 1 -1.31202E+00 -3.46891E-01
+ 2 3.15762E-01 9.73094E-02
+ 3 -2.67777E-02 -4.03770E-01
+ 4 -5.78122E-02 1.51256E-02
+4 0 *********** CCCS-gly-cys
+ 1 1.05530E+00 -2.71210E-01
+ 2 -2.81933E-01 7.48024E-02
+ 3 1.25272E-01 1.80323E-01
+ 4 1.43032E-01 -5.75962E-02
+4 0 *********** CCCS-gly-met
+ 1 5.59661E-01 -4.30726E-01
+ 2 1.59708E-02 3.21011E-01
+ 3 1.41705E-01 5.97102E-02
+ 4 6.16920E-03 -2.23828E-02
+4 0 *********** CCCS-gly-phe
+ 1 6.31592E-01 -4.93574E-01
+ 2 2.94775E-01 2.32488E-01
+ 3 8.39615E-02 -7.91540E-02
+ 4 9.13991E-03 -2.63888E-02
+4 0 *********** CCCS-gly-ile
+ 1 7.12981E-01 -5.34709E-01
+ 2 -1.27405E-02 5.03012E-01
+ 3 2.43981E-01 5.88027E-02
+ 4 -3.82917E-02 -2.25025E-02
+4 0 *********** CCCS-gly-leu
+ 1 3.09062E-01 -5.62007E-01
+ 2 2.56275E-01 6.35740E-01
+ 3 1.29028E-01 -3.73514E-02
+ 4 -3.11769E-02 1.22591E-01
+4 0 *********** CCCS-gly-val
+ 1 6.23875E-01 -5.04248E-01
+ 2 6.09769E-02 5.57747E-01
+ 3 2.26979E-01 6.63831E-02
+ 4 -4.14762E-02 1.60595E-02
+4 0 *********** CCCS-gly-trp
+ 1 6.24927E-01 -5.51690E-01
+ 2 1.61460E-01 2.34716E-01
+ 3 1.14487E-01 -5.02453E-02
+ 4 -7.56294E-03 -3.44011E-02
+4 0 *********** CCCS-gly-tyr
+ 1 6.17606E-01 -4.90395E-01
+ 2 2.79775E-01 2.04943E-01
+ 3 7.73478E-02 -8.23004E-02
+ 4 9.25598E-03 -4.02325E-02
+4 0 *********** CCCS-gly-ala
+ 1 3.79194E-01 -3.71425E-01
+ 2 -4.16749E-01 5.89014E-01
+ 3 1.03228E-01 1.14247E-01
+ 4 -1.09076E-01 -9.45324E-02
+4 0 *********** CCCS-gly-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-gly-thr
- 1 4.57424E-01 -8.67678E-02
- 2 1.28569E-01 1.09103E-01
- 3 -2.33037E-01 4.60976E-02
- 4 -5.93924E-02 1.08358E-02
- 5 -2.15120E-01 -6.32073E-02
- 6 -2.37075E-02 -8.99065E-02
-6 0 *********** CCCS-gly-ser
- 1 6.67576E-01 2.48115E-01
- 2 2.38248E-01 3.85789E-01
- 3 -1.28001E-01 -5.20498E-01
- 4 -2.18853E-01 2.92302E-01
- 5 1.91238E-01 -1.54118E-01
- 6 -2.04810E-01 -6.73284E-01
-6 0 *********** CCCS-gly-gln
- 1 4.76782E-01 -5.98358E-02
- 2 1.24267E-01 7.76858E-02
- 3 -1.69073E-01 -9.98932E-02
- 4 -8.12065E-02 9.06815E-02
- 5 -3.06432E-02 -4.47218E-02
- 6 -6.58390E-02 -1.85102E-01
-6 0 *********** CCCS-gly-asn
- 1 4.86179E-01 4.08421E-01
- 2 1.16672E-01 2.14662E-01
- 3 1.87335E-02 -2.47021E-01
- 4 -1.61836E-01 1.35914E-01
- 5 -7.66595E-03 -8.39430E-02
- 6 -1.15627E-01 -2.88805E-01
-6 0 *********** CCCS-gly-glu
- 1 5.44361E-01 -1.50876E-01
- 2 1.37788E-01 4.74025E-02
- 3 -2.00329E-01 -6.97037E-02
- 4 -3.74576E-02 1.09528E-01
- 5 -2.98151E-02 -5.92646E-02
- 6 -6.12747E-02 -2.00258E-01
-6 0 *********** CCCS-gly-asp
- 1 4.75990E-01 4.78872E-01
- 2 -9.63724E-03 2.27361E-01
- 3 -9.55173E-02 -2.98200E-01
- 4 -1.37522E-01 8.86822E-02
- 5 -3.18774E-02 -6.14416E-02
- 6 -1.06927E-01 -2.59530E-01
-6 0 *********** CCCS-gly-his
- 1 5.94418E-01 3.24725E-01
- 2 1.84943E-01 8.32994E-02
- 3 -2.74370E-02 -2.01278E-01
- 4 -4.19998E-02 5.08601E-02
- 5 -1.18496E-01 -2.77518E-02
- 6 -3.69596E-02 -1.30117E-01
-6 0 *********** CCCS-gly-arg
- 1 2.76896E-01 -2.70128E-01
- 2 1.05035E-01 6.31898E-02
- 3 -1.15581E-01 5.97726E-03
- 4 -2.61558E-02 5.42305E-02
- 5 -8.91478E-02 -3.61035E-02
- 6 -4.06115E-02 -1.30985E-01
-6 0 *********** CCCS-gly-lys
- 1 2.40455E-01 -2.59200E-01
- 2 1.17128E-01 6.12889E-02
- 3 -1.55424E-01 5.08981E-02
- 4 2.31521E-02 4.06903E-02
- 5 -1.55136E-01 -1.45200E-02
- 6 -4.88160E-04 -8.09440E-02
-6 0 *********** CCCS-gly-pro
- 1 -8.20714E-01 -1.07499E+00
- 2 1.19829E-01 -7.99437E-02
- 3 -3.15940E-01 -5.47967E-02
- 4 -3.13390E-01 -2.21335E-01
- 5 3.89615E-01 -4.80336E-01
- 6 -1.26530E-01 -4.35970E-01
-6 0 *********** CCCS-thr-cys
- 1 -9.73915E-01 7.35774E-01
- 2 -1.23609E-01 2.61624E-01
- 3 -1.92760E-01 -3.09095E-02
- 4 -5.81870E-02 7.80827E-02
- 5 -1.54105E-01 -2.55381E-02
- 6 -1.88546E-02 -5.50090E-02
-6 0 *********** CCCS-thr-met
- 1 -5.18933E-01 6.68105E-01
- 2 1.11495E-01 6.72371E-02
- 3 -7.20765E-02 -2.46471E-02
- 4 9.44287E-03 1.04709E-01
- 5 -1.34117E-01 -2.08467E-02
- 6 6.10031E-04 -1.04424E-02
-6 0 *********** CCCS-thr-phe
- 1 -3.97853E-01 8.41275E-01
- 2 -4.54986E-04 1.36538E-02
- 3 -3.78885E-02 -1.58583E-01
- 4 -1.52024E-02 8.64865E-02
- 5 -5.48202E-02 -3.08228E-02
- 6 -3.82294E-02 -3.01918E-02
-6 0 *********** CCCS-thr-ile
- 1 -5.49217E-01 8.62893E-01
- 2 9.33589E-02 -7.92132E-03
- 3 -2.10370E-02 2.15014E-02
- 4 3.30795E-02 1.54745E-01
- 5 -1.92171E-01 -4.17530E-02
- 6 3.95512E-02 9.72977E-03
-6 0 *********** CCCS-thr-leu
- 1 -3.68031E-01 6.93374E-01
- 2 2.56670E-01 -7.03700E-02
- 3 1.14024E-01 -7.56363E-02
- 4 -1.66834E-02 1.18747E-01
- 5 8.28342E-03 -6.35328E-02
- 6 -9.39555E-03 -3.39105E-02
-6 0 *********** CCCS-thr-val
- 1 -4.88856E-01 8.01321E-01
- 2 1.14009E-01 -6.78863E-02
- 3 1.89288E-02 1.53374E-02
- 4 -1.78451E-02 1.51567E-01
- 5 -1.31760E-01 -5.29118E-02
- 6 1.53807E-02 1.96228E-02
-6 0 *********** CCCS-thr-trp
- 1 -3.74161E-01 7.95824E-01
- 2 2.55345E-02 8.55719E-02
- 3 -7.83362E-02 -1.11102E-01
- 4 -1.87679E-03 8.02720E-02
- 5 -8.07349E-02 -2.29455E-02
- 6 -2.51424E-02 -2.56810E-02
-6 0 *********** CCCS-thr-tyr
- 1 -3.78591E-01 8.09980E-01
- 2 -3.08368E-02 5.37961E-02
- 3 -1.82949E-02 -1.95112E-01
- 4 -6.37520E-02 1.09526E-01
- 5 2.76774E-03 -4.42103E-02
- 6 -7.25785E-02 -9.24006E-02
-6 0 *********** CCCS-thr-ala
- 1 -6.83703E-01 3.09597E-01
- 2 3.00326E-01 3.21246E-01
- 3 -6.61942E-03 3.53475E-02
- 4 -1.64570E-01 1.78561E-01
- 5 5.63825E-02 -2.94821E-02
- 6 -1.22402E-01 -1.85362E-01
-6 0 *********** CCCS-thr-gly
+4 0 *********** CCCS-gly-thr
+ 1 6.57016E-01 -5.23203E-01
+ 2 -1.55691E-01 4.36606E-01
+ 3 1.63097E-01 7.72411E-02
+ 4 -5.08481E-02 -5.09956E-02
+4 0 *********** CCCS-gly-ser
+ 1 1.38111E+00 -7.82855E-02
+ 2 -4.27476E-01 -9.10809E-02
+ 3 4.91534E-02 1.05681E-01
+ 4 2.23522E-01 -1.77805E-02
+4 0 *********** CCCS-gly-gln
+ 1 7.31678E-01 -4.64989E-01
+ 2 -1.82075E-01 1.90454E-01
+ 3 9.44762E-02 -1.36678E-02
+ 4 -8.83443E-03 -7.23257E-02
+4 0 *********** CCCS-gly-asn
+ 1 1.10318E+00 -1.62883E-01
+ 2 -3.33718E-01 -1.57769E-01
+ 3 8.30386E-03 8.43924E-02
+ 4 1.23489E-01 -1.06169E-02
+4 0 *********** CCCS-gly-glu
+ 1 7.71618E-01 -5.64459E-01
+ 2 -1.20693E-01 2.82620E-01
+ 3 1.39428E-01 -3.01628E-02
+ 4 -4.97869E-02 -6.92910E-02
+4 0 *********** CCCS-gly-asp
+ 1 1.23444E+00 -1.45663E-01
+ 2 -3.65504E-01 -1.04661E-01
+ 3 -1.21221E-02 1.18730E-01
+ 4 1.36505E-01 -1.49867E-02
+4 0 *********** CCCS-gly-his
+ 1 1.09895E+00 -2.02858E-01
+ 2 -1.98594E-01 -1.80072E-01
+ 3 9.81912E-02 1.20783E-01
+ 4 1.24016E-01 1.69661E-03
+4 0 *********** CCCS-gly-arg
+ 1 4.39569E-01 -5.16540E-01
+ 2 1.63975E-01 3.16742E-01
+ 3 1.08828E-01 -4.63823E-02
+ 4 -3.80107E-03 2.77407E-02
+4 0 *********** CCCS-gly-lys
+ 1 3.13346E-01 -5.05745E-01
+ 2 1.34799E-01 4.28675E-01
+ 3 1.08750E-01 2.69008E-02
+ 4 -6.54716E-03 3.14417E-02
+4 0 *********** CCCS-gly-pro
+ 1 9.51272E-01 -2.20991E-01
+ 2 -1.33605E-01 -2.03419E-01
+ 3 9.40695E-02 4.48809E-01
+ 4 -2.76656E-01 -6.75602E-01
+4 0 *********** CCCS-thr-cys
+ 1 -9.08281E-01 -3.01908E-01
+ 2 1.22001E-01 -1.73580E-01
+ 3 9.59156E-02 -5.68275E-02
+ 4 -4.85807E-02 3.02211E-02
+4 0 *********** CCCS-thr-met
+ 1 -5.99276E-01 8.31179E-02
+ 2 -1.73015E-01 -4.98070E-02
+ 3 3.09270E-02 -4.60290E-02
+ 4 1.14955E-02 4.59420E-02
+4 0 *********** CCCS-thr-phe
+ 1 -6.12939E-01 1.38964E-01
+ 2 -1.40114E-01 8.16806E-02
+ 3 -7.88300E-02 -1.33683E-02
+ 4 5.48961E-02 1.08369E-02
+4 0 *********** CCCS-thr-ile
+ 1 -7.53367E-01 1.22220E-01
+ 2 -2.23915E-01 -1.18124E-01
+ 3 2.93067E-02 -1.05475E-01
+ 4 1.74803E-02 7.51009E-02
+4 0 *********** CCCS-thr-leu
+ 1 -5.00823E-01 3.19599E-01
+ 2 -3.79156E-01 6.48330E-02
+ 3 -2.52279E-02 -5.60938E-02
+ 4 6.15224E-02 3.48828E-02
+4 0 *********** CCCS-thr-val
+ 1 -6.66163E-01 1.57839E-01
+ 2 -2.82039E-01 -6.85402E-02
+ 3 2.84170E-02 -8.92678E-02
+ 4 3.68848E-02 7.29793E-02
+4 0 *********** CCCS-thr-trp
+ 1 -6.67197E-01 1.59905E-01
+ 2 -1.32462E-01 4.54309E-03
+ 3 -4.41262E-02 -2.98930E-02
+ 4 4.77017E-02 2.33546E-02
+4 0 *********** CCCS-thr-tyr
+ 1 -6.05186E-01 1.32909E-01
+ 2 -1.27191E-01 7.92306E-02
+ 3 -7.55896E-02 -1.24676E-02
+ 4 5.38346E-02 1.19690E-02
+4 0 *********** CCCS-thr-ala
+ 1 -4.92108E-01 7.29893E-02
+ 2 -2.94868E-01 -2.89306E-01
+ 3 7.57361E-02 -3.65210E-02
+ 4 -5.57898E-02 3.86971E-02
+4 0 *********** CCCS-thr-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-thr-thr
- 1 -8.04850E-01 6.34067E-01
- 2 3.53480E-01 8.59159E-02
- 3 -5.51317E-02 8.72910E-02
- 4 -5.34245E-02 1.25794E-01
- 5 -1.11279E-01 -7.55151E-03
- 6 -2.66515E-02 1.99144E-02
-6 0 *********** CCCS-thr-ser
- 1 -1.45861E+00 9.59043E-01
- 2 -2.38011E-01 5.51363E-01
- 3 -2.48847E-01 -9.56814E-02
- 4 -1.12450E-01 2.70957E-02
- 5 -1.00017E-01 -3.40204E-02
- 6 -2.86364E-02 -1.32637E-01
-6 0 *********** CCCS-thr-gln
- 1 -6.32372E-01 6.71550E-01
- 2 1.63728E-02 2.86149E-01
- 3 -1.66417E-01 -3.37439E-02
- 4 1.77423E-03 8.19872E-02
- 5 -1.53942E-01 -1.53292E-04
- 6 -1.23639E-02 -5.53743E-02
-6 0 *********** CCCS-thr-asn
- 1 -1.03433E+00 4.09047E-01
- 2 -2.77161E-01 3.24094E-01
- 3 -2.62541E-01 -8.78655E-02
- 4 -5.51330E-02 3.17565E-02
- 5 -1.05941E-01 -4.02931E-02
- 6 -2.30689E-02 -1.37470E-01
-6 0 *********** CCCS-thr-glu
- 1 -6.15271E-01 8.33101E-01
- 2 3.32850E-02 2.65117E-01
- 3 -1.25442E-01 -1.37410E-02
- 4 1.53345E-04 1.07136E-01
- 5 -1.41108E-01 -2.34588E-03
- 6 -1.35197E-02 -3.23064E-02
-6 0 *********** CCCS-thr-asp
- 1 -1.29908E+00 7.05288E-02
- 2 -1.02899E-02 4.83748E-01
- 3 -2.18954E-01 1.36122E-02
- 4 -8.30945E-02 4.89137E-02
- 5 -1.48283E-01 -1.60566E-02
- 6 -2.75662E-02 -1.94595E-01
-6 0 *********** CCCS-thr-his
- 1 -9.44876E-01 7.91166E-01
- 2 -3.79635E-01 2.05229E-01
- 3 -2.47076E-01 -6.06951E-02
- 4 -2.57910E-02 5.47849E-02
- 5 -1.30011E-01 -3.77452E-02
- 6 -2.29715E-02 -3.97199E-02
-6 0 *********** CCCS-thr-arg
- 1 -3.54177E-01 6.29749E-01
- 2 1.05175E-01 5.01073E-02
- 3 1.57998E-02 -9.68862E-02
- 4 -3.96656E-02 1.17640E-01
- 5 -3.29978E-02 -4.53935E-02
- 6 -3.60784E-02 -7.69516E-02
-6 0 *********** CCCS-thr-lys
- 1 -3.90529E-01 6.13558E-01
- 2 1.97040E-01 -1.71595E-02
- 3 -2.14843E-03 -4.64495E-02
- 4 1.69210E-02 9.34230E-02
- 5 -8.87130E-02 -3.88683E-02
- 6 7.46317E-03 -9.07747E-03
-6 0 *********** CCCS-thr-pro
- 1 2.59928E+00 8.74400E-02
- 2 -3.29028E-01 -1.48846E-01
- 3 -1.01892E+00 -5.35085E-01
- 4 -6.92488E-01 4.11673E-01
- 5 2.67418E-01 2.24527E-03
- 6 -2.38086E-02 -4.75161E-01
-6 0 *********** CCCS-ser-cys
- 1 -2.01357E-01 2.33386E-01
- 2 -5.79785E-02 3.69954E-01
- 3 -1.14049E-01 -5.67362E-02
- 4 -1.29814E-01 1.56102E-01
- 5 -2.51327E-03 -6.13662E-02
- 6 -1.01032E-01 -2.67833E-01
-6 0 *********** CCCS-ser-met
- 1 -1.40766E-01 1.79386E-01
- 2 1.58556E-01 1.48664E-01
- 3 -1.09079E-01 -5.49521E-02
- 4 -3.00591E-03 5.83452E-02
- 5 -7.75879E-02 -2.40944E-02
- 6 -1.92557E-02 -1.08483E-01
-6 0 *********** CCCS-ser-phe
- 1 -9.54761E-02 1.79887E-01
- 2 1.92788E-01 8.40652E-02
- 3 -1.27432E-01 -8.12442E-02
- 4 -3.59069E-02 4.67367E-02
- 5 -6.84345E-02 -3.72774E-02
- 6 -3.48405E-02 -1.00470E-01
-6 0 *********** CCCS-ser-ile
- 1 -1.55023E-01 2.13465E-01
- 2 2.30533E-01 1.25745E-01
- 3 -1.59405E-01 -1.36217E-02
- 4 1.05861E-01 3.24593E-02
- 5 -1.74385E-01 -4.36821E-03
- 6 4.20326E-02 -3.72277E-02
-6 0 *********** CCCS-ser-leu
- 1 -9.72519E-02 1.51748E-01
- 2 2.89010E-01 4.09925E-02
- 3 -9.53202E-02 -9.28013E-02
- 4 1.15867E-02 2.91369E-02
- 5 -6.70235E-02 -3.61754E-02
- 6 -1.62530E-02 -8.47683E-02
-6 0 *********** CCCS-ser-val
- 1 -1.11154E-01 1.85372E-01
- 2 1.92527E-01 9.21050E-02
- 3 -9.83184E-02 -4.32966E-02
- 4 2.26004E-02 5.34533E-02
- 5 -8.77735E-02 -2.26007E-02
- 6 -4.93527E-03 -7.82858E-02
-6 0 *********** CCCS-ser-trp
- 1 -1.15520E-01 1.92161E-01
- 2 2.09433E-01 9.51733E-02
- 3 -1.61579E-01 -4.67171E-02
- 4 2.51823E-02 3.19336E-02
- 5 -1.29825E-01 -2.16786E-02
- 6 2.36862E-03 -6.41219E-02
-6 0 *********** CCCS-ser-tyr
- 1 -9.40078E-02 1.70314E-01
- 2 1.74206E-01 9.85230E-02
- 3 -1.13731E-01 -9.69467E-02
- 4 -6.33172E-02 6.18644E-02
- 5 -3.87677E-02 -4.57224E-02
- 6 -5.17542E-02 -1.34357E-01
-6 0 *********** CCCS-ser-ala
- 1 -2.14778E-01 1.04168E-01
- 2 1.55360E-01 2.76206E-01
- 3 -2.42691E-02 -6.94838E-02
- 4 -4.80736E-02 1.14306E-01
- 5 1.26398E-04 -3.30005E-02
- 6 -5.25844E-02 -2.14116E-01
-6 0 *********** CCCS-ser-gly
+4 0 *********** CCCS-thr-thr
+ 1 -7.45482E-01 9.60972E-02
+ 2 -1.90156E-01 -1.75476E-01
+ 3 3.87974E-02 -7.26032E-02
+ 4 -1.74927E-02 6.66013E-02
+4 0 *********** CCCS-thr-ser
+ 1 -1.16265E+00 -5.77886E-01
+ 2 3.67680E-01 -6.64155E-02
+ 3 4.94013E-02 -1.47955E-01
+ 4 -2.71067E-02 -2.54014E-03
+4 0 *********** CCCS-thr-gln
+ 1 -7.72626E-01 -6.76124E-03
+ 2 -4.44939E-02 -1.74265E-01
+ 3 -2.88422E-02 -7.51459E-02
+ 4 -1.11548E-02 5.16024E-02
+4 0 *********** CCCS-thr-asn
+ 1 -9.17112E-01 -4.37406E-01
+ 2 2.66940E-01 -1.36434E-01
+ 3 3.00889E-02 -4.33786E-02
+ 4 9.23315E-03 -1.18078E-02
+4 0 *********** CCCS-thr-glu
+ 1 -8.40641E-01 6.81535E-02
+ 2 -8.78889E-02 -1.68137E-01
+ 3 -3.19566E-02 -9.00317E-02
+ 4 5.28663E-03 5.34595E-02
+4 0 *********** CCCS-thr-asp
+ 1 -1.02189E+00 -4.79146E-01
+ 2 2.95262E-01 -1.28086E-01
+ 3 2.31717E-02 -4.87398E-02
+ 4 1.39044E-02 -1.88108E-02
+4 0 *********** CCCS-thr-his
+ 1 -8.80916E-01 -4.26539E-01
+ 2 2.42448E-01 -9.14291E-02
+ 3 1.05248E-01 -4.81750E-02
+ 4 -1.92150E-02 -4.72863E-02
+4 0 *********** CCCS-thr-arg
+ 1 -5.48048E-01 2.09077E-01
+ 2 -1.99186E-01 4.01057E-02
+ 3 -2.39989E-02 -5.14240E-02
+ 4 2.87024E-02 2.01337E-02
+4 0 *********** CCCS-thr-lys
+ 1 -4.75450E-01 2.54118E-01
+ 2 -2.76141E-01 3.68121E-02
+ 3 1.98402E-02 -3.23959E-02
+ 4 3.17753E-02 2.41329E-02
+4 0 *********** CCCS-thr-pro
+ 1 -1.46596E+00 -1.78082E-01
+ 2 3.64356E-01 -2.36500E-01
+ 3 -2.18599E-01 -2.65481E-01
+ 4 2.98444E-02 -8.51331E-03
+4 0 *********** CCCS-ser-cys
+ 1 -1.04837E+00 -6.10995E-01
+ 2 -1.41701E-01 -2.85795E-01
+ 3 2.72913E-01 -5.66441E-02
+ 4 -1.15430E-01 1.18261E-01
+4 0 *********** CCCS-ser-met
+ 1 -7.53509E-01 -1.07956E-01
+ 2 -3.96696E-01 7.46363E-02
+ 3 1.45212E-01 -1.03265E-01
+ 4 -5.12330E-03 4.33481E-02
+4 0 *********** CCCS-ser-phe
+ 1 -8.86745E-01 -1.49766E-01
+ 2 -2.52304E-01 3.97771E-01
+ 3 -3.63396E-02 -1.43342E-01
+ 4 3.20231E-02 6.09485E-02
+4 0 *********** CCCS-ser-ile
+ 1 -9.81862E-01 -1.93356E-01
+ 2 -6.47003E-01 1.05026E-01
+ 3 2.60292E-01 -1.94239E-01
+ 4 -1.34015E-03 -6.87713E-04
+4 0 *********** CCCS-ser-leu
+ 1 -6.55843E-01 1.84284E-01
+ 2 -7.79829E-01 3.69260E-01
+ 3 9.90230E-02 -1.49577E-01
+ 4 2.84450E-02 -5.30532E-02
+4 0 *********** CCCS-ser-val
+ 1 -8.84912E-01 -1.43814E-01
+ 2 -7.19527E-01 1.80517E-01
+ 3 2.55997E-01 -1.65153E-01
+ 4 2.14705E-02 -1.71934E-02
+4 0 *********** CCCS-ser-trp
+ 1 -9.10824E-01 -7.98788E-02
+ 2 -2.66428E-01 2.50268E-01
+ 3 1.56151E-03 -1.57157E-01
+ 4 3.90715E-02 6.46676E-02
+4 0 *********** CCCS-ser-tyr
+ 1 -8.72452E-01 -1.33650E-01
+ 2 -2.16929E-01 3.71744E-01
+ 3 -4.87209E-02 -1.43150E-01
+ 4 4.01808E-02 7.72556E-02
+4 0 *********** CCCS-ser-ala
+ 1 -5.84042E-01 2.54320E-02
+ 2 -7.23774E-01 -4.84211E-01
+ 3 2.01131E-01 1.15642E-02
+ 4 2.58175E-02 4.67270E-02
+4 0 *********** CCCS-ser-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-ser-thr
- 1 -1.97745E-01 1.94350E-01
- 2 2.45763E-01 1.88788E-01
- 3 -1.29060E-01 -2.02534E-02
- 4 6.11179E-02 5.19690E-02
- 5 -1.31878E-01 -2.90480E-03
- 6 1.64361E-02 -7.65508E-02
-6 0 *********** CCCS-ser-ser
- 1 -2.59272E-01 2.20590E-01
- 2 -8.91058E-02 5.87615E-01
- 3 -7.83145E-02 -1.25140E-01
- 4 -2.04629E-01 2.79464E-01
- 5 8.99667E-02 -9.65788E-02
- 6 -1.92229E-01 -4.95892E-01
-6 0 *********** CCCS-ser-gln
- 1 -1.57205E-01 2.02914E-01
- 2 7.69219E-02 2.87705E-01
- 3 -1.06061E-01 -4.95700E-02
- 4 -4.76242E-02 8.41118E-02
- 5 -5.30026E-02 -2.77578E-02
- 6 -4.30948E-02 -1.67343E-01
-6 0 *********** CCCS-ser-asn
- 1 -2.42118E-01 2.33249E-01
- 2 -1.86843E-01 3.29565E-01
- 3 -1.67620E-01 -6.04880E-02
- 4 -1.59874E-01 1.75704E-01
- 5 2.45600E-02 -9.72523E-02
- 6 -1.17590E-01 -3.03357E-01
-6 0 *********** CCCS-ser-glu
- 1 -1.30009E-01 2.18036E-01
- 2 1.29245E-01 2.86502E-01
- 3 -9.11889E-02 -4.26156E-02
- 4 -1.88100E-02 7.31172E-02
- 5 -5.91435E-02 -1.66696E-02
- 6 -2.80203E-02 -1.41942E-01
-6 0 *********** CCCS-ser-asp
- 1 -2.47345E-01 2.00869E-01
- 2 -1.61372E-01 3.33032E-01
- 3 -1.23519E-01 -8.38555E-03
- 4 -1.23644E-01 1.68634E-01
- 5 -1.94355E-02 -7.11329E-02
- 6 -1.08142E-01 -2.56694E-01
-6 0 *********** CCCS-ser-his
- 1 -1.76492E-01 2.94431E-01
- 2 -1.61494E-01 2.67854E-01
- 3 -1.87059E-01 5.16473E-02
- 4 -5.30497E-02 1.06951E-01
- 5 -1.20051E-01 -3.62362E-02
- 6 -5.13175E-02 -1.17525E-01
-6 0 *********** CCCS-ser-arg
- 1 -1.09439E-01 1.45623E-01
- 2 1.86111E-01 1.04780E-01
- 3 -8.84665E-02 -9.85560E-02
- 4 -3.40626E-02 6.04373E-02
- 5 -3.74758E-02 -4.22340E-02
- 6 -3.85764E-02 -1.34467E-01
-6 0 *********** CCCS-ser-lys
- 1 -1.24755E-01 1.51129E-01
- 2 2.25444E-01 6.38137E-02
- 3 -1.11822E-01 -7.39267E-02
- 4 1.80943E-02 3.58601E-02
- 5 -9.00375E-02 -2.91304E-02
- 6 -7.55953E-03 -8.05218E-02
-6 0 *********** CCCS-ser-pro
- 1 1.23702E-01 -4.50490E-01
- 2 -4.02980E-01 -2.53802E-02
- 3 -1.16646E-01 -3.27125E-01
- 4 2.09094E-02 3.66850E-01
- 5 2.13675E-01 -1.35415E-01
- 6 -2.40190E-01 -5.90493E-01
-6 0 *********** CCCS-gln-cys
- 1 -9.11312E-01 4.86885E-01
- 2 -1.46991E-01 3.27481E-01
- 3 -1.98803E-01 -5.36682E-02
- 4 -8.46335E-02 5.74431E-02
- 5 -1.06336E-01 -3.30588E-02
- 6 -3.59060E-02 -1.25129E-01
-6 0 *********** CCCS-gln-met
- 1 -5.83890E-01 5.57960E-01
- 2 1.54372E-01 1.07370E-01
- 3 -9.64036E-02 1.08135E-02
- 4 -8.64409E-03 9.44125E-02
- 5 -1.31562E-01 -1.63110E-02
- 6 -6.61752E-03 -1.32402E-02
-6 0 *********** CCCS-gln-phe
- 1 -5.10151E-01 7.11157E-01
- 2 9.52633E-02 2.44852E-02
- 3 -3.42555E-02 -9.90817E-02
- 4 -2.15379E-02 8.59399E-02
- 5 -5.93982E-02 -3.53258E-02
- 6 -2.67572E-02 -2.43571E-02
-6 0 *********** CCCS-gln-ile
- 1 -6.26222E-01 7.06991E-01
- 2 1.88476E-01 5.54091E-02
- 3 -1.01818E-01 8.27453E-02
- 4 1.62938E-02 1.11930E-01
- 5 -1.77627E-01 -1.19435E-02
- 6 1.40951E-02 4.82151E-02
-6 0 *********** CCCS-gln-leu
- 1 -4.72781E-01 5.98271E-01
- 2 3.29982E-01 3.21820E-03
- 3 8.55752E-02 -1.49748E-02
- 4 -3.65208E-02 1.10640E-01
- 5 2.90995E-02 -4.52029E-02
- 6 -2.63046E-02 -2.09016E-02
-6 0 *********** CCCS-gln-val
- 1 -5.71526E-01 6.71004E-01
- 2 2.05800E-01 -2.14564E-03
- 3 -5.13530E-02 6.69360E-02
- 4 -3.45057E-02 1.12505E-01
- 5 -1.11706E-01 -2.25606E-02
- 6 -1.18741E-02 4.71185E-02
-6 0 *********** CCCS-gln-trp
- 1 -4.72439E-01 6.75729E-01
- 2 8.52127E-02 9.84391E-02
- 3 -6.43783E-02 -7.28928E-02
- 4 -2.35855E-02 8.75507E-02
- 5 -6.96126E-02 -2.92815E-02
- 6 -2.66099E-02 -4.08272E-02
-6 0 *********** CCCS-gln-tyr
- 1 -4.86038E-01 6.86094E-01
- 2 5.71755E-02 5.68739E-02
- 3 -8.13157E-03 -1.36463E-01
- 4 -6.98789E-02 1.09435E-01
- 5 -4.18579E-03 -4.95531E-02
- 6 -5.90516E-02 -9.01847E-02
-6 0 *********** CCCS-gln-ala
- 1 -6.95425E-01 2.17216E-01
- 2 2.84597E-01 4.17930E-01
- 3 -7.23778E-02 4.76704E-02
- 4 -1.68734E-01 1.85224E-01
- 5 1.82523E-02 -2.31172E-02
- 6 -1.28547E-01 -2.21400E-01
-6 0 *********** CCCS-gln-gly
+4 0 *********** CCCS-ser-thr
+ 1 -9.04091E-01 -1.14038E-01
+ 2 -5.51718E-01 -1.18229E-01
+ 3 1.98503E-01 -1.00926E-01
+ 4 -5.00525E-03 2.62573E-02
+4 0 *********** CCCS-ser-ser
+ 1 -1.21903E+00 -1.13590E+00
+ 2 1.10102E-01 -4.44413E-01
+ 3 8.51782E-02 -3.48694E-02
+ 4 -1.04601E-01 1.08914E-02
+4 0 *********** CCCS-ser-gln
+ 1 -9.00164E-01 -1.94782E-01
+ 2 -2.32413E-01 -1.81809E-01
+ 3 3.42637E-03 -1.34012E-01
+ 4 -1.13839E-02 8.78613E-02
+4 0 *********** CCCS-ser-asn
+ 1 -1.00506E+00 -7.20429E-01
+ 2 1.84999E-01 -3.76506E-01
+ 3 2.75927E-02 -1.52767E-02
+ 4 -3.90060E-02 7.92171E-02
+4 0 *********** CCCS-ser-glu
+ 1 -1.01415E+00 -1.64873E-01
+ 2 -3.38425E-01 -8.18384E-02
+ 3 2.91754E-02 -1.74557E-01
+ 4 2.24211E-02 6.18333E-02
+4 0 *********** CCCS-ser-asp
+ 1 -1.10875E+00 -8.78415E-01
+ 2 1.03249E-01 -4.25272E-01
+ 3 1.91494E-02 6.71157E-02
+ 4 -1.74906E-02 6.09993E-02
+4 0 *********** CCCS-ser-his
+ 1 -1.05074E+00 -6.95434E-01
+ 2 2.12439E-01 -1.69617E-01
+ 3 2.07914E-01 -5.80538E-02
+ 4 -2.43340E-02 -1.00341E-02
+4 0 *********** CCCS-ser-arg
+ 1 -7.23069E-01 4.20717E-02
+ 2 -3.65552E-01 2.58250E-01
+ 3 4.00962E-02 -1.34337E-01
+ 4 -1.39705E-02 -6.73942E-03
+4 0 *********** CCCS-ser-lys
+ 1 -6.17249E-01 1.39288E-01
+ 2 -5.23413E-01 2.16254E-01
+ 3 1.24271E-01 -8.68823E-02
+ 4 1.69791E-02 -1.07765E-02
+4 0 *********** CCCS-ser-pro
+ 1 -1.80852E+00 -1.13946E+00
+ 2 -2.23424E-01 -3.04544E-01
+ 3 -2.06562E-02 -2.72521E-01
+ 4 -1.05566E-01 1.34185E-01
+4 0 *********** CCCS-gln-cys
+ 1 -8.92424E-01 -5.07387E-01
+ 2 -2.42104E-02 -4.24023E-02
+ 3 1.02088E-01 -1.39458E-01
+ 4 -9.38427E-03 5.45754E-02
+4 0 *********** CCCS-gln-met
+ 1 -6.52447E-01 -1.51895E-02
+ 2 -1.90492E-01 6.94244E-02
+ 3 3.21838E-02 -7.49475E-02
+ 4 -2.23481E-03 3.86823E-02
+4 0 *********** CCCS-gln-phe
+ 1 -7.26817E-01 3.40560E-02
+ 2 -7.70293E-02 2.09886E-01
+ 3 -9.15611E-02 -3.53401E-02
+ 4 5.22865E-02 4.07427E-02
+4 0 *********** CCCS-gln-ile
+ 1 -8.16693E-01 -5.89724E-02
+ 2 -2.43021E-01 7.80091E-02
+ 3 2.10517E-02 -1.25236E-01
+ 4 -3.01370E-02 3.17542E-02
+4 0 *********** CCCS-gln-leu
+ 1 -5.65181E-01 1.91999E-01
+ 2 -3.29198E-01 2.16747E-01
+ 3 2.92818E-03 -4.08838E-02
+ 4 -2.38458E-02 5.62057E-02
+4 0 *********** CCCS-gln-val
+ 1 -7.29652E-01 -3.69959E-03
+ 2 -2.89669E-01 1.14813E-01
+ 3 3.10314E-02 -1.01801E-01
+ 4 -2.27825E-02 4.27327E-02
+4 0 *********** CCCS-gln-trp
+ 1 -7.66079E-01 5.39907E-02
+ 2 -9.03988E-02 1.34352E-01
+ 3 -6.45456E-02 -5.61522E-02
+ 4 4.25952E-02 3.57759E-02
+4 0 *********** CCCS-gln-tyr
+ 1 -7.16548E-01 3.52292E-02
+ 2 -6.46610E-02 1.99411E-01
+ 3 -9.15575E-02 -3.54834E-02
+ 4 5.79160E-02 4.34072E-02
+4 0 *********** CCCS-gln-ala
+ 1 -4.87342E-01 -3.86897E-02
+ 2 -3.86278E-01 -1.76526E-01
+ 3 5.77582E-02 -1.40930E-02
+ 4 -3.92891E-02 -5.27642E-02
+4 0 *********** CCCS-gln-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-gln-thr
- 1 -8.50426E-01 4.89491E-01
- 2 3.99478E-01 2.09026E-01
- 3 -1.41284E-01 1.10074E-01
- 4 -3.46067E-02 1.07820E-01
- 5 -1.58159E-01 1.26326E-02
- 6 -2.36300E-02 1.51098E-03
-6 0 *********** CCCS-gln-ser
- 1 -1.17660E+00 4.15931E-01
- 2 -3.09073E-01 7.38224E-01
- 3 -2.33517E-01 -1.31343E-01
- 4 -1.66299E-01 1.19421E-02
- 5 -2.90927E-02 -5.55764E-02
- 6 -5.19929E-02 -3.03291E-01
-6 0 *********** CCCS-gln-gln
- 1 -6.65168E-01 5.29683E-01
- 2 1.33416E-02 3.02582E-01
- 3 -1.66643E-01 -1.01792E-02
- 4 -1.88124E-02 7.46125E-02
- 5 -1.51702E-01 -5.00831E-03
- 6 -1.36721E-02 -7.48026E-02
-6 0 *********** CCCS-gln-asn
- 1 -9.21672E-01 2.24533E-01
- 2 -3.68596E-01 3.07480E-01
- 3 -2.19442E-01 -1.34108E-01
- 4 -7.48838E-02 3.57739E-02
- 5 -6.55911E-02 -3.98105E-02
- 6 -4.46918E-02 -1.89147E-01
-6 0 *********** CCCS-gln-glu
- 1 -6.71126E-01 6.53436E-01
- 2 7.06504E-02 3.01008E-01
- 3 -1.52336E-01 2.65357E-02
- 4 -2.46344E-02 9.46027E-02
- 5 -1.41873E-01 -2.62087E-03
- 6 -1.84508E-02 -4.30433E-02
-6 0 *********** CCCS-gln-asp
- 1 -1.07041E+00 -8.04267E-02
- 2 -2.16234E-01 4.79218E-01
- 3 -1.80989E-01 -9.83985E-03
- 4 -1.04428E-01 2.70860E-02
- 5 -1.09274E-01 -3.65505E-02
- 6 -3.50950E-02 -2.36589E-01
-6 0 *********** CCCS-gln-his
- 1 -8.73104E-01 5.15609E-01
- 2 -3.54744E-01 2.29926E-01
- 3 -2.83231E-01 -8.62836E-02
- 4 -2.19414E-02 3.58189E-02
- 5 -1.13149E-01 -2.96843E-02
- 6 -2.63492E-02 -8.21583E-02
-6 0 *********** CCCS-gln-arg
- 1 -4.39318E-01 5.47481E-01
- 2 1.54876E-01 8.03944E-02
- 3 3.33358E-03 -4.84185E-02
- 4 -5.17340E-02 1.13528E-01
- 5 -3.25373E-02 -4.28430E-02
- 6 -3.52592E-02 -7.06679E-02
-6 0 *********** CCCS-gln-lys
- 1 -4.73087E-01 5.33347E-01
- 2 2.48300E-01 3.16521E-02
- 3 -2.28692E-02 4.71487E-04
- 4 2.11293E-03 8.64580E-02
- 5 -7.88371E-02 -2.82020E-02
- 6 -1.78632E-03 -4.88562E-03
-6 0 *********** CCCS-gln-pro
- 1 1.45069E+00 2.94471E-01
- 2 -7.56812E-01 -4.03113E-01
- 3 -8.17387E-01 -7.63617E-01
- 4 -3.99971E-01 3.80166E-01
- 5 2.98555E-01 1.23289E-01
- 6 -7.36956E-02 -3.46063E-01
-6 0 *********** CCCS-asn-cys
- 1 -9.81243E-01 7.38947E-01
- 2 -1.27216E-01 2.64776E-01
- 3 -1.89802E-01 -2.42134E-02
- 4 -6.40229E-02 8.29857E-02
- 5 -1.58300E-01 -2.72951E-02
- 6 -1.91836E-02 -6.96382E-02
-6 0 *********** CCCS-asn-met
- 1 -5.28844E-01 6.71403E-01
- 2 1.13849E-01 6.62739E-02
- 3 -6.58071E-02 -2.43809E-02
- 4 9.86111E-03 1.07713E-01
- 5 -1.34817E-01 -2.10671E-02
- 6 1.44374E-03 -6.33229E-03
-6 0 *********** CCCS-asn-phe
- 1 -4.09384E-01 8.49907E-01
- 2 8.47627E-04 1.23925E-02
- 3 -3.57423E-02 -1.65132E-01
- 4 -1.03322E-02 8.46689E-02
- 5 -5.54326E-02 -2.93923E-02
- 6 -3.75781E-02 -3.35103E-02
-6 0 *********** CCCS-asn-ile
- 1 -5.64930E-01 8.72982E-01
- 2 9.55892E-02 -1.75407E-02
- 3 -9.29467E-03 2.53323E-02
- 4 3.21160E-02 1.61331E-01
- 5 -1.92475E-01 -4.48645E-02
- 6 4.18638E-02 1.77003E-02
-6 0 *********** CCCS-asn-leu
- 1 -3.78356E-01 6.97780E-01
- 2 2.66114E-01 -7.37090E-02
- 3 1.27426E-01 -7.85588E-02
- 4 -1.59465E-02 1.21971E-01
- 5 1.23339E-02 -6.63152E-02
- 6 -7.42130E-03 -4.14076E-02
-6 0 *********** CCCS-asn-val
- 1 -5.04308E-01 8.10321E-01
- 2 1.18691E-01 -7.66508E-02
- 3 2.96895E-02 1.85849E-02
- 4 -2.11599E-02 1.57982E-01
- 5 -1.30426E-01 -5.59587E-02
- 6 1.61186E-02 1.32968E-02
-6 0 *********** CCCS-asn-trp
- 1 -3.82884E-01 8.01736E-01
- 2 2.56529E-02 8.67306E-02
- 3 -7.40116E-02 -1.16420E-01
- 4 -3.60492E-04 8.04250E-02
- 5 -7.83570E-02 -2.24886E-02
- 6 -2.59654E-02 -2.75688E-02
-6 0 *********** CCCS-asn-tyr
- 1 -3.88971E-01 8.18540E-01
- 2 -3.06476E-02 5.30580E-02
- 3 -1.58166E-02 -2.02065E-01
- 4 -5.97860E-02 1.08157E-01
- 5 2.45092E-03 -4.32023E-02
- 6 -7.22697E-02 -9.84011E-02
-6 0 *********** CCCS-asn-ala
- 1 -6.90939E-01 3.08987E-01
- 2 3.07003E-01 3.25144E-01
- 3 -3.00035E-03 4.85177E-02
- 4 -1.66492E-01 1.79254E-01
- 5 5.68450E-02 -2.69275E-02
- 6 -1.24516E-01 -1.76014E-01
-6 0 *********** CCCS-asn-gly
+4 0 *********** CCCS-gln-thr
+ 1 -7.80760E-01 -6.13841E-02
+ 2 -2.35612E-01 -1.24991E-02
+ 3 2.49293E-02 -8.20607E-02
+ 4 -3.06675E-02 6.90262E-03
+4 0 *********** CCCS-gln-ser
+ 1 -1.03788E+00 -8.88069E-01
+ 2 5.34243E-02 5.10125E-02
+ 3 1.50205E-01 -2.08371E-01
+ 4 -3.01558E-02 2.63968E-02
+4 0 *********** CCCS-gln-gln
+ 1 -8.04285E-01 -1.29508E-01
+ 2 -9.34017E-02 -6.37414E-02
+ 3 -5.87788E-02 -9.53064E-02
+ 4 1.00333E-03 3.02731E-02
+4 0 *********** CCCS-gln-asn
+ 1 -8.38358E-01 -6.14264E-01
+ 2 8.17134E-02 -9.24163E-02
+ 3 5.51736E-02 -1.03468E-01
+ 4 2.68239E-02 5.56177E-02
+4 0 *********** CCCS-gln-glu
+ 1 -8.96027E-01 -8.93257E-02
+ 2 -1.12126E-01 -9.88092E-03
+ 3 -6.86206E-02 -1.06623E-01
+ 4 1.56355E-03 1.49187E-02
+4 0 *********** CCCS-gln-asp
+ 1 -9.22333E-01 -7.13812E-01
+ 2 5.02866E-02 -5.05264E-02
+ 3 7.80833E-02 -1.05819E-01
+ 4 2.92431E-02 4.29878E-02
+4 0 *********** CCCS-gln-his
+ 1 -8.45032E-01 -5.83060E-01
+ 2 1.08484E-01 -2.73417E-02
+ 3 1.30266E-01 -1.25573E-01
+ 4 1.45373E-02 5.90930E-03
+4 0 *********** CCCS-gln-arg
+ 1 -6.20503E-01 1.20432E-01
+ 2 -1.63002E-01 1.57146E-01
+ 3 -2.74049E-02 -5.80091E-02
+ 4 -8.73186E-03 2.35626E-02
+4 0 *********** CCCS-gln-lys
+ 1 -5.28575E-01 1.73025E-01
+ 2 -2.56094E-01 1.51170E-01
+ 3 3.46088E-02 -3.83785E-02
+ 4 -5.83263E-03 2.90363E-02
+4 0 *********** CCCS-gln-pro
+ 1 -1.54478E+00 -7.03617E-01
+ 2 1.77756E-01 2.22580E-01
+ 3 -8.84134E-02 -4.66760E-01
+ 4 -7.23375E-02 1.06350E-01
+4 0 *********** CCCS-asn-cys
+ 1 -9.82525E-01 -3.51632E-01
+ 2 -2.52515E-01 -1.11964E-01
+ 3 1.39576E-01 -1.96110E-01
+ 4 -4.65103E-03 8.79464E-02
+4 0 *********** CCCS-asn-met
+ 1 -6.91677E-01 7.41541E-02
+ 2 -2.56189E-01 2.36130E-01
+ 3 1.10713E-02 -1.44067E-01
+ 4 3.06039E-02 2.74767E-02
+4 0 *********** CCCS-asn-phe
+ 1 -8.00835E-01 1.00115E-01
+ 2 -1.07459E-02 3.91741E-01
+ 3 -1.24297E-01 -2.84366E-02
+ 4 6.54387E-02 -3.93435E-03
+4 0 *********** CCCS-asn-ile
+ 1 -8.79446E-01 4.35312E-02
+ 2 -3.90415E-01 3.37774E-01
+ 3 -7.49679E-03 -2.43611E-01
+ 4 6.60991E-03 3.25451E-02
+4 0 *********** CCCS-asn-leu
+ 1 -5.41915E-01 2.78822E-01
+ 2 -3.53500E-01 5.72411E-01
+ 3 -4.69218E-02 -8.76969E-02
+ 4 -2.13995E-02 -1.69204E-03
+4 0 *********** CCCS-asn-val
+ 1 -7.84056E-01 7.67350E-02
+ 2 -4.05088E-01 4.09834E-01
+ 3 6.41454E-03 -2.09256E-01
+ 4 1.00253E-02 1.59303E-02
+4 0 *********** CCCS-asn-trp
+ 1 -8.15609E-01 1.46881E-01
+ 2 -8.28472E-02 2.99037E-01
+ 3 -1.03392E-01 -7.04564E-02
+ 4 6.42105E-02 -3.85424E-03
+4 0 *********** CCCS-asn-tyr
+ 1 -7.88025E-01 1.06272E-01
+ 2 2.66433E-03 3.62107E-01
+ 3 -1.27500E-01 -2.45225E-02
+ 4 7.87480E-02 -3.57991E-03
+4 0 *********** CCCS-asn-ala
+ 1 -5.02302E-01 7.78595E-02
+ 2 -6.89111E-01 -3.28269E-03
+ 3 8.33343E-02 -1.01783E-01
+ 4 4.50539E-03 -2.04876E-02
+4 0 *********** CCCS-asn-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-asn-thr
- 1 -8.20768E-01 6.36954E-01
- 2 3.63215E-01 8.57219E-02
- 3 -4.68729E-02 9.70987E-02
- 4 -5.60658E-02 1.28204E-01
- 5 -1.17309E-01 -3.91918E-03
- 6 -2.61601E-02 3.27244E-02
-6 0 *********** CCCS-asn-ser
- 1 -1.48082E+00 9.73863E-01
- 2 -2.39555E-01 5.47266E-01
- 3 -2.48177E-01 -6.78655E-02
- 4 -1.22407E-01 3.06881E-02
- 5 -1.14624E-01 -3.91831E-02
- 6 -2.09710E-02 -1.05869E-01
-6 0 *********** CCCS-asn-gln
- 1 -6.38601E-01 6.72814E-01
- 2 1.27532E-02 2.90820E-01
- 3 -1.61997E-01 -3.36020E-02
- 4 3.71112E-03 8.47105E-02
- 5 -1.56262E-01 1.06251E-03
- 6 -1.20994E-02 -5.67135E-02
-6 0 *********** CCCS-asn-asn
- 1 -1.03529E+00 4.09695E-01
- 2 -2.82458E-01 3.32931E-01
- 3 -2.72391E-01 -8.49418E-02
- 4 -6.30248E-02 3.01867E-02
- 5 -1.08756E-01 -4.42677E-02
- 6 -1.90216E-02 -1.43975E-01
-6 0 *********** CCCS-asn-glu
- 1 -6.24444E-01 8.36389E-01
- 2 3.08403E-02 2.67311E-01
- 3 -1.18897E-01 -1.36358E-02
- 4 3.23561E-03 1.10909E-01
- 5 -1.41815E-01 -2.03370E-03
- 6 -1.20046E-02 -3.04993E-02
-6 0 *********** CCCS-asn-asp
- 1 -1.31230E+00 6.08324E-02
- 2 -4.66516E-03 4.89280E-01
- 3 -2.31381E-01 2.65240E-02
- 4 -7.91981E-02 5.00199E-02
- 5 -1.61024E-01 -1.30875E-02
- 6 -2.50555E-02 -1.88560E-01
-6 0 *********** CCCS-asn-his
- 1 -9.47521E-01 8.00586E-01
- 2 -3.84671E-01 2.07295E-01
- 3 -2.53791E-01 -5.33085E-02
- 4 -3.84714E-02 5.82850E-02
- 5 -1.28432E-01 -4.38477E-02
- 6 -2.18627E-02 -3.71136E-02
-6 0 *********** CCCS-asn-arg
- 1 -3.62848E-01 6.33833E-01
- 2 1.08980E-01 4.83759E-02
- 3 2.27920E-02 -9.80776E-02
- 4 -3.78147E-02 1.19442E-01
- 5 -3.38356E-02 -4.62190E-02
- 6 -3.48041E-02 -8.54747E-02
-6 0 *********** CCCS-asn-lys
- 1 -3.99732E-01 6.17116E-01
- 2 2.02924E-01 -1.94415E-02
- 3 6.02302E-03 -4.65917E-02
- 4 1.73784E-02 9.51469E-02
- 5 -8.75523E-02 -4.03373E-02
- 6 8.76732E-03 -1.66787E-02
-6 0 *********** CCCS-asn-pro
- 1 2.80167E+00 4.81081E-01
- 2 -2.07001E-01 4.08283E-01
- 3 -9.00332E-01 -5.09962E-02
- 4 -6.53642E-01 6.46736E-01
- 5 1.64194E-01 4.80608E-02
- 6 -1.25901E-01 -4.74117E-01
-6 0 *********** CCCS-glu-cys
- 1 -6.44744E-01 1.94963E-01
- 2 -1.23400E-01 4.72754E-01
- 3 -1.80354E-01 -6.53012E-02
- 4 -1.39261E-01 9.03505E-02
- 5 -4.92369E-02 -4.94551E-02
- 6 -7.20235E-02 -2.70591E-01
-6 0 *********** CCCS-glu-met
- 1 -5.11248E-01 3.59750E-01
- 2 2.15710E-01 1.46131E-01
- 3 -1.10520E-01 8.35251E-03
- 4 -4.87025E-03 7.79767E-02
- 5 -1.08686E-01 -1.06252E-02
- 6 -1.36649E-02 -4.54532E-02
-6 0 *********** CCCS-glu-phe
- 1 -4.70125E-01 4.63112E-01
- 2 2.17518E-01 3.42238E-02
- 3 -6.31706E-02 -5.49241E-02
- 4 -1.55684E-02 6.04560E-02
- 5 -6.59428E-02 -3.24503E-02
- 6 -1.88665E-02 -2.84531E-02
-6 0 *********** CCCS-glu-ile
- 1 -5.52165E-01 4.40316E-01
- 2 2.86501E-01 1.19971E-01
- 3 -1.57400E-01 7.00972E-02
- 4 5.58583E-02 7.03934E-02
- 5 -1.59460E-01 5.39092E-03
- 6 1.42226E-02 3.27814E-02
-6 0 *********** CCCS-glu-leu
- 1 -4.63638E-01 4.18084E-01
- 2 3.98640E-01 5.96325E-03
- 3 5.68312E-02 -1.85701E-02
- 4 -2.67309E-02 8.01931E-02
- 5 4.54554E-02 -3.67789E-02
- 6 -3.30695E-02 -2.59191E-02
-6 0 *********** CCCS-glu-val
- 1 -5.10509E-01 4.37881E-01
- 2 2.83195E-01 4.98836E-02
- 3 -1.01193E-01 4.27127E-02
- 4 9.21017E-03 7.68823E-02
- 5 -9.97160E-02 -6.91023E-03
- 6 -9.61703E-03 1.81664E-02
-6 0 *********** CCCS-glu-trp
- 1 -4.41061E-01 4.37295E-01
- 2 1.95095E-01 1.00936E-01
- 3 -7.60768E-02 -3.90511E-02
- 4 -2.35785E-02 7.06695E-02
- 5 -6.54462E-02 -2.81214E-02
- 6 -2.40580E-02 -4.58926E-02
-6 0 *********** CCCS-glu-tyr
- 1 -4.45689E-01 4.45616E-01
- 2 1.77315E-01 5.85893E-02
- 3 -3.58001E-02 -8.51341E-02
- 4 -6.16139E-02 8.15937E-02
- 5 -1.81915E-02 -4.55243E-02
- 6 -4.70711E-02 -8.39008E-02
-6 0 *********** CCCS-glu-ala
- 1 -6.18616E-01 1.05845E-01
- 2 2.99093E-01 4.46810E-01
- 3 -7.80112E-02 1.64218E-02
- 4 -1.36393E-01 1.82471E-01
- 5 7.08592E-03 -2.56853E-02
- 6 -1.11483E-01 -2.70616E-01
-6 0 *********** CCCS-glu-gly
+4 0 *********** CCCS-asn-thr
+ 1 -8.11013E-01 6.59891E-02
+ 2 -4.26966E-01 1.74948E-01
+ 3 1.65546E-02 -1.73767E-01
+ 4 1.62799E-02 1.83886E-02
+4 0 *********** CCCS-asn-ser
+ 1 -1.06150E+00 -7.20223E-01
+ 2 -2.64205E-01 -2.70668E-01
+ 3 1.82935E-01 -1.36872E-01
+ 4 -8.21001E-02 2.23903E-02
+4 0 *********** CCCS-asn-gln
+ 1 -8.31456E-01 6.94561E-03
+ 2 -2.57390E-01 -6.59889E-04
+ 3 -9.34647E-02 -1.03075E-01
+ 4 5.54687E-02 4.35942E-02
+4 0 *********** CCCS-asn-asn
+ 1 -9.21745E-01 -4.50877E-01
+ 2 -1.26524E-01 -3.04363E-01
+ 3 8.91806E-02 -6.87808E-02
+ 4 3.45027E-03 4.84865E-02
+4 0 *********** CCCS-asn-glu
+ 1 -9.20190E-01 5.35560E-02
+ 2 -2.79315E-01 1.17997E-01
+ 3 -1.06749E-01 -1.38302E-01
+ 4 4.73823E-02 2.11619E-02
+4 0 *********** CCCS-asn-asp
+ 1 -1.00292E+00 -5.61433E-01
+ 2 -2.15450E-01 -2.73663E-01
+ 3 1.43746E-01 -4.62991E-02
+ 4 -2.84376E-03 2.89608E-02
+4 0 *********** CCCS-asn-his
+ 1 -9.46800E-01 -4.06137E-01
+ 2 -2.58896E-02 -2.06499E-01
+ 3 1.62179E-01 -1.74252E-01
+ 4 -5.68963E-02 -5.58782E-03
+4 0 *********** CCCS-asn-arg
+ 1 -6.34581E-01 2.06273E-01
+ 2 -1.47943E-01 3.52432E-01
+ 3 -7.07501E-02 -8.73140E-02
+ 4 -7.27691E-03 1.39072E-02
+4 0 *********** CCCS-asn-lys
+ 1 -5.18691E-01 2.52763E-01
+ 2 -2.70015E-01 3.87332E-01
+ 3 1.24213E-02 -9.85008E-02
+ 4 -1.38280E-04 -9.05424E-04
+4 0 *********** CCCS-asn-pro
+ 1 -1.35260E+00 -5.40866E-01
+ 2 -4.23502E-01 7.57498E-02
+ 3 -9.66377E-03 -3.95838E-01
+ 4 -1.07416E-01 1.33385E-01
+4 0 *********** CCCS-glu-cys
+ 1 -9.26658E-01 -5.25130E-01
+ 2 -1.46141E-02 -8.43380E-02
+ 3 1.18348E-01 -1.11715E-01
+ 4 -2.52483E-02 5.22072E-02
+4 0 *********** CCCS-glu-met
+ 1 -6.70146E-01 -2.45277E-02
+ 2 -2.20947E-01 5.40152E-02
+ 3 5.24231E-02 -7.59906E-02
+ 4 -3.45329E-03 4.10627E-02
+4 0 *********** CCCS-glu-phe
+ 1 -7.46132E-01 1.54575E-02
+ 2 -1.12917E-01 2.21803E-01
+ 3 -8.16859E-02 -5.39614E-02
+ 4 5.01778E-02 4.34568E-02
+4 0 *********** CCCS-glu-ile
+ 1 -8.39765E-01 -6.34876E-02
+ 2 -2.92138E-01 4.98946E-02
+ 3 5.66111E-02 -1.30373E-01
+ 4 -2.67769E-02 3.74880E-02
+4 0 *********** CCCS-glu-leu
+ 1 -5.78575E-01 2.02103E-01
+ 2 -3.98231E-01 2.12278E-01
+ 3 1.49364E-02 -5.94025E-02
+ 4 -1.26158E-02 4.46635E-02
+4 0 *********** CCCS-glu-val
+ 1 -7.49311E-01 -7.45102E-03
+ 2 -3.44907E-01 9.25320E-02
+ 3 6.20556E-02 -1.08748E-01
+ 4 -1.58245E-02 4.46948E-02
+4 0 *********** CCCS-glu-trp
+ 1 -7.88016E-01 4.08201E-02
+ 2 -1.22548E-01 1.35274E-01
+ 3 -5.01657E-02 -7.13558E-02
+ 4 4.18897E-02 4.10282E-02
+4 0 *********** CCCS-glu-tyr
+ 1 -7.36009E-01 1.70572E-02
+ 2 -9.74425E-02 2.10864E-01
+ 3 -8.25035E-02 -5.34527E-02
+ 4 5.51966E-02 4.71361E-02
+4 0 *********** CCCS-glu-ala
+ 1 -5.03992E-01 -2.97856E-02
+ 2 -4.18076E-01 -2.36919E-01
+ 3 7.80568E-02 -7.41743E-03
+ 4 -3.12610E-02 -3.56243E-02
+4 0 *********** CCCS-glu-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-glu-thr
- 1 -7.21241E-01 2.93041E-01
- 2 4.22480E-01 2.75123E-01
- 3 -1.58471E-01 6.54361E-02
- 4 1.20432E-02 1.04930E-01
- 5 -1.74487E-01 1.65512E-02
- 6 -6.12906E-03 -6.50591E-02
-6 0 *********** CCCS-glu-ser
- 1 -7.96094E-01 2.61733E-02
- 2 -2.55872E-01 8.87296E-01
- 3 -1.97595E-01 -1.07366E-01
- 4 -2.41049E-01 9.81757E-02
- 5 3.03423E-02 -1.01531E-01
- 6 -1.05699E-01 -5.02121E-01
-6 0 *********** CCCS-glu-gln
- 1 -5.50017E-01 2.96221E-01
- 2 8.62141E-02 3.54391E-01
- 3 -1.59793E-01 1.20104E-02
- 4 -4.13417E-02 7.45607E-02
- 5 -1.25927E-01 -6.95700E-03
- 6 -2.55146E-02 -1.17098E-01
-6 0 *********** CCCS-glu-asn
- 1 -6.09527E-01 5.05370E-02
- 2 -3.94989E-01 4.05200E-01
- 3 -2.23811E-01 -1.29032E-01
- 4 -1.18679E-01 6.37159E-02
- 5 -1.07685E-02 -7.52060E-02
- 6 -7.51705E-02 -3.02381E-01
-6 0 *********** CCCS-glu-glu
- 1 -5.70372E-01 3.61149E-01
- 2 1.78779E-01 3.57460E-01
- 3 -1.59046E-01 4.52333E-02
- 4 -2.83182E-02 8.62852E-02
- 5 -1.19881E-01 6.03565E-04
- 6 -2.52658E-02 -9.67984E-02
-6 0 *********** CCCS-glu-asp
- 1 -6.78440E-01 -1.23587E-01
- 2 -3.18349E-01 4.98469E-01
- 3 -1.81267E-01 -2.37933E-04
- 4 -1.07773E-01 4.92910E-02
- 5 -8.05626E-02 -5.58527E-02
- 6 -5.97200E-02 -2.69735E-01
-6 0 *********** CCCS-glu-his
- 1 -5.61071E-01 2.29906E-01
- 2 -3.20855E-01 3.49371E-01
- 3 -3.09949E-01 -3.10144E-02
- 4 -3.18311E-02 1.79957E-02
- 5 -1.28616E-01 -3.38856E-02
- 6 -1.55391E-02 -1.38973E-01
-6 0 *********** CCCS-glu-arg
- 1 -4.17167E-01 3.73858E-01
- 2 2.26484E-01 8.44185E-02
- 3 -1.76010E-02 -3.85900E-02
- 4 -4.34399E-02 8.99905E-02
- 5 -2.37963E-02 -3.70675E-02
- 6 -3.63097E-02 -7.94303E-02
-6 0 *********** CCCS-glu-lys
- 1 -4.47727E-01 3.74205E-01
- 2 3.01625E-01 3.89187E-02
- 3 -3.71745E-02 -3.56318E-03
- 4 5.61010E-03 6.64647E-02
- 5 -6.05905E-02 -2.38101E-02
- 6 -7.99529E-03 -2.17338E-02
-6 0 *********** CCCS-glu-pro
- 1 7.79796E-01 2.98627E-01
- 2 -9.38815E-01 -3.78320E-01
- 3 -6.13159E-01 -7.45476E-01
- 4 -2.01332E-01 3.83505E-01
- 5 2.53644E-01 1.08493E-01
- 6 -1.68969E-01 -3.72029E-01
-6 0 *********** CCCS-asp-cys
- 1 -9.97031E-01 6.99023E-01
- 2 -1.26321E-01 2.57632E-01
- 3 -1.91182E-01 -2.36356E-02
- 4 -6.62200E-02 7.61185E-02
- 5 -1.53450E-01 -2.99479E-02
- 6 -1.83912E-02 -6.66655E-02
-6 0 *********** CCCS-asp-met
- 1 -5.49775E-01 6.55826E-01
- 2 1.18803E-01 7.13744E-02
- 3 -6.92404E-02 -1.54224E-02
- 4 4.08586E-03 1.07368E-01
- 5 -1.36154E-01 -2.14907E-02
- 6 5.70187E-04 -1.86158E-02
-6 0 *********** CCCS-asp-phe
- 1 -4.40009E-01 8.34433E-01
- 2 1.22408E-02 1.22408E-02
- 3 -3.01591E-02 -1.55765E-01
- 4 -1.03417E-02 8.83168E-02
- 5 -5.70103E-02 -3.00169E-02
- 6 -3.52175E-02 -2.88786E-02
-6 0 *********** CCCS-asp-ile
- 1 -5.90845E-01 8.52911E-01
- 2 1.08821E-01 -1.12148E-02
- 3 -2.10850E-02 4.10654E-02
- 4 2.23100E-02 1.57328E-01
- 5 -1.92537E-01 -4.25249E-02
- 6 3.74685E-02 2.14973E-02
-6 0 *********** CCCS-asp-leu
- 1 -4.04890E-01 6.84546E-01
- 2 2.76599E-01 -5.59060E-02
- 3 1.21962E-01 -6.29690E-02
- 4 -2.15471E-02 1.22683E-01
- 5 1.51119E-02 -6.30277E-02
- 6 -1.02194E-02 -3.84813E-02
-6 0 *********** CCCS-asp-val
- 1 -5.28959E-01 7.91975E-01
- 2 1.34050E-01 -6.57810E-02
- 3 1.70532E-02 3.28594E-02
- 4 -2.96533E-02 1.52338E-01
- 5 -1.28133E-01 -5.16307E-02
- 6 1.04984E-02 1.72839E-02
-6 0 *********** CCCS-asp-trp
- 1 -4.09982E-01 7.87692E-01
- 2 2.98843E-02 8.73770E-02
- 3 -6.82174E-02 -1.11088E-01
- 4 -3.77378E-03 8.44168E-02
- 5 -7.68584E-02 -2.35420E-02
- 6 -2.61672E-02 -2.81123E-02
-6 0 *********** CCCS-asp-tyr
- 1 -4.18556E-01 8.03896E-01
- 2 -2.05075E-02 5.15386E-02
- 3 -9.20229E-03 -1.93185E-01
- 4 -5.94545E-02 1.11660E-01
- 5 5.98079E-04 -4.38009E-02
- 6 -6.96195E-02 -8.90867E-02
-6 0 *********** CCCS-asp-ala
- 1 -6.98016E-01 2.92305E-01
- 2 3.01054E-01 3.44519E-01
- 3 -2.03807E-02 5.42119E-02
- 4 -1.69511E-01 1.79480E-01
- 5 4.78578E-02 -2.45370E-02
- 6 -1.27324E-01 -1.79644E-01
-6 0 *********** CCCS-asp-gly
+4 0 *********** CCCS-glu-thr
+ 1 -8.04543E-01 -6.20769E-02
+ 2 -2.72922E-01 -5.06136E-02
+ 3 5.50426E-02 -8.02036E-02
+ 4 -2.90912E-02 1.44716E-02
+4 0 *********** CCCS-glu-ser
+ 1 -1.10702E+00 -9.22384E-01
+ 2 1.12736E-01 8.19736E-03
+ 3 1.30474E-01 -1.88277E-01
+ 4 -3.04892E-02 2.35917E-02
+4 0 *********** CCCS-glu-gln
+ 1 -8.28918E-01 -1.37209E-01
+ 2 -1.06707E-01 -9.58291E-02
+ 3 -4.04594E-02 -9.53937E-02
+ 4 -3.91334E-03 3.89483E-02
+4 0 *********** CCCS-glu-asn
+ 1 -8.85321E-01 -6.34665E-01
+ 2 1.27028E-01 -1.28080E-01
+ 3 4.17177E-02 -8.32055E-02
+ 4 2.28902E-02 5.16544E-02
+4 0 *********** CCCS-glu-glu
+ 1 -9.23757E-01 -9.51260E-02
+ 2 -1.38889E-01 -4.10626E-02
+ 3 -4.33032E-02 -1.12057E-01
+ 4 7.27614E-04 2.53686E-02
+4 0 *********** CCCS-glu-asp
+ 1 -9.77706E-01 -7.38687E-01
+ 2 9.78649E-02 -9.31284E-02
+ 3 5.92724E-02 -7.92006E-02
+ 4 3.02832E-02 3.85875E-02
+4 0 *********** CCCS-glu-his
+ 1 -8.93583E-01 -6.06150E-01
+ 2 1.48877E-01 -4.86929E-02
+ 3 1.28527E-01 -1.05344E-01
+ 4 1.04248E-02 -9.87261E-05
+4 0 *********** CCCS-glu-arg
+ 1 -6.37452E-01 1.14969E-01
+ 2 -2.00239E-01 1.56626E-01
+ 3 -1.47293E-02 -7.20167E-02
+ 4 -6.09780E-03 2.15053E-02
+4 0 *********** CCCS-glu-lys
+ 1 -5.43918E-01 1.75298E-01
+ 2 -3.01529E-01 1.44322E-01
+ 3 4.75835E-02 -4.73502E-02
+ 4 -4.03201E-04 2.48047E-02
+4 0 *********** CCCS-glu-pro
+ 1 -1.67644E+00 -7.35341E-01
+ 2 2.37419E-01 1.70243E-01
+ 3 -1.04694E-01 -4.62205E-01
+ 4 -6.66424E-02 1.21892E-01
+4 0 *********** CCCS-asp-cys
+ 1 -1.03238E+00 -2.69353E-01
+ 2 -1.16102E-01 -1.92723E-01
+ 3 2.01706E-01 -1.68112E-01
+ 4 -5.06421E-02 1.21374E-01
+4 0 *********** CCCS-asp-met
+ 1 -6.63656E-01 1.16359E-01
+ 2 -2.65698E-01 1.09534E-01
+ 3 2.43880E-02 -1.33974E-01
+ 4 3.02189E-02 4.72081E-02
+4 0 *********** CCCS-asp-phe
+ 1 -7.28477E-01 1.52816E-01
+ 2 -8.33367E-02 2.72364E-01
+ 3 -1.44641E-01 -3.77114E-02
+ 4 8.48424E-02 1.22855E-02
+4 0 *********** CCCS-asp-ile
+ 1 -8.27894E-01 1.62544E-01
+ 2 -3.95099E-01 1.22719E-01
+ 3 5.87906E-03 -2.42851E-01
+ 4 3.67157E-02 5.84739E-02
+4 0 *********** CCCS-asp-leu
+ 1 -4.99550E-01 3.71081E-01
+ 2 -4.24432E-01 3.79671E-01
+ 3 -7.57202E-02 -9.18426E-02
+ 4 -2.69963E-03 1.11169E-02
+4 0 *********** CCCS-asp-val
+ 1 -7.27116E-01 1.90071E-01
+ 2 -4.23302E-01 1.91954E-01
+ 3 4.45001E-03 -2.05201E-01
+ 4 3.69698E-02 4.86853E-02
+4 0 *********** CCCS-asp-trp
+ 1 -7.63719E-01 1.93795E-01
+ 2 -1.35580E-01 1.80915E-01
+ 3 -1.04279E-01 -8.15742E-02
+ 4 8.03391E-02 1.55771E-02
+4 0 *********** CCCS-asp-tyr
+ 1 -7.21039E-01 1.50123E-01
+ 2 -6.83138E-02 2.55494E-01
+ 3 -1.41767E-01 -3.74128E-02
+ 4 9.22455E-02 1.67042E-02
+4 0 *********** CCCS-asp-ala
+ 1 -5.09884E-01 1.39071E-01
+ 2 -5.82229E-01 -1.54482E-01
+ 3 9.77774E-02 -1.06883E-01
+ 4 -2.92733E-03 -2.38612E-02
+4 0 *********** CCCS-asp-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-asp-thr
- 1 -8.38573E-01 6.13571E-01
- 2 3.69770E-01 1.07496E-01
- 3 -6.45620E-02 1.08295E-01
- 4 -5.86976E-02 1.21760E-01
- 5 -1.23664E-01 8.22144E-04
- 6 -2.83985E-02 5.10016E-02
-6 0 *********** CCCS-asp-ser
- 1 -1.48959E+00 8.64154E-01
- 2 -2.15943E-01 5.36815E-01
- 3 -2.46468E-01 -5.46087E-02
- 4 -1.22284E-01 2.46075E-02
- 5 -1.13558E-01 -3.72872E-02
- 6 -2.09380E-02 -1.19012E-01
-6 0 *********** CCCS-asp-gln
- 1 -6.56019E-01 6.52627E-01
- 2 5.79576E-03 2.86406E-01
- 3 -1.59419E-01 -3.00292E-02
- 4 -1.00441E-04 8.48135E-02
- 5 -1.57816E-01 -4.13425E-04
- 6 -1.16900E-02 -6.65338E-02
-6 0 *********** CCCS-asp-asn
- 1 -1.03975E+00 3.71734E-01
- 2 -2.89858E-01 3.14263E-01
- 3 -2.64437E-01 -9.13576E-02
- 4 -6.19805E-02 2.72515E-02
- 5 -1.06475E-01 -4.19360E-02
- 6 -1.93552E-02 -1.44348E-01
-6 0 *********** CCCS-asp-glu
- 1 -6.48369E-01 8.13660E-01
- 2 2.82459E-02 2.64689E-01
- 3 -1.19550E-01 -7.04718E-03
- 4 -3.36693E-03 1.11845E-01
- 5 -1.44559E-01 -3.58371E-03
- 6 -1.24614E-02 -3.46108E-02
-6 0 *********** CCCS-asp-asp
- 1 -1.29753E+00 2.65459E-02
- 2 -3.06469E-02 4.83209E-01
- 3 -2.33713E-01 2.04404E-02
- 4 -7.72705E-02 4.09645E-02
- 5 -1.58877E-01 -1.70410E-02
- 6 -2.10641E-02 -1.88636E-01
-6 0 *********** CCCS-asp-his
- 1 -9.65353E-01 7.47449E-01
- 2 -3.68693E-01 1.89461E-01
- 3 -2.53524E-01 -5.36286E-02
- 4 -4.34655E-02 5.60329E-02
- 5 -1.22341E-01 -4.53601E-02
- 6 -2.21752E-02 -4.11459E-02
-6 0 *********** CCCS-asp-arg
- 1 -3.85607E-01 6.23253E-01
- 2 1.14950E-01 5.46028E-02
- 3 2.17237E-02 -8.67396E-02
- 4 -4.15619E-02 1.20730E-01
- 5 -3.45807E-02 -4.66637E-02
- 6 -3.39816E-02 -8.10344E-02
-6 0 *********** CCCS-asp-lys
- 1 -4.21597E-01 6.05804E-01
- 2 2.10311E-01 -8.25029E-03
- 3 2.02289E-03 -3.46247E-02
- 4 1.31257E-02 9.51840E-02
- 5 -8.64350E-02 -3.84507E-02
- 6 7.18128E-03 -8.27121E-03
-6 0 *********** CCCS-asp-pro
- 1 2.26796E+00 6.23124E-01
- 2 -3.82677E-01 4.07630E-01
- 3 -8.18844E-01 -1.95232E-01
- 4 -5.05059E-01 4.13256E-01
- 5 2.75484E-01 -1.12268E-01
- 6 -7.84791E-02 -4.98608E-01
-6 0 *********** CCCS-his-cys
- 1 -8.63888E-01 6.76378E-01
- 2 -4.48144E-02 3.37429E-01
- 3 -2.10632E-01 2.30033E-03
- 4 -6.76010E-02 8.56385E-02
- 5 -1.51094E-01 -1.27568E-02
- 6 -3.19859E-02 -5.75892E-02
-6 0 *********** CCCS-his-met
- 1 -4.58613E-01 6.58648E-01
- 2 1.19148E-01 5.19708E-02
- 3 -6.44825E-02 -4.52051E-02
- 4 2.45626E-02 9.73142E-02
- 5 -1.23557E-01 -1.92512E-02
- 6 2.23192E-03 -1.10593E-02
-6 0 *********** CCCS-his-phe
- 1 -3.21031E-01 8.10404E-01
- 2 7.09563E-03 3.62991E-03
- 3 -5.24106E-02 -1.67958E-01
- 4 -2.47272E-02 7.35316E-02
- 5 -5.45630E-02 -3.72492E-02
- 6 -3.95690E-02 -3.04668E-02
-6 0 *********** CCCS-his-ile
- 1 -4.72358E-01 8.30524E-01
- 2 1.04724E-01 -1.35500E-02
- 3 -1.26273E-02 -9.34127E-03
- 4 6.51524E-02 1.35821E-01
- 5 -1.71130E-01 -3.57772E-02
- 6 4.36683E-02 6.58656E-03
-6 0 *********** CCCS-his-leu
- 1 -3.05106E-01 6.92156E-01
- 2 2.30653E-01 -1.28555E-01
- 3 1.21764E-01 -1.27078E-01
- 4 -6.44528E-03 1.08273E-01
- 5 -4.07436E-03 -7.19991E-02
- 6 -6.57272E-03 -4.08188E-02
-6 0 *********** CCCS-his-val
- 1 -4.18899E-01 7.85425E-01
- 2 1.03479E-01 -8.69921E-02
- 3 2.98356E-02 -2.24746E-02
- 4 1.54446E-02 1.42092E-01
- 5 -1.23853E-01 -5.13223E-02
- 6 2.31611E-02 3.44775E-03
-6 0 *********** CCCS-his-trp
- 1 -3.09869E-01 7.66338E-01
- 2 4.66758E-02 6.87273E-02
- 3 -8.61790E-02 -1.14845E-01
- 4 4.88486E-06 6.95167E-02
- 5 -8.52984E-02 -2.57814E-02
- 6 -2.24417E-02 -2.26035E-02
-6 0 *********** CCCS-his-tyr
- 1 -3.04282E-01 7.79295E-01
- 2 -2.07532E-02 4.57225E-02
- 3 -3.45587E-02 -2.01736E-01
- 4 -7.34067E-02 9.74022E-02
- 5 1.86468E-03 -5.05100E-02
- 6 -7.36737E-02 -9.41744E-02
-6 0 *********** CCCS-his-ala
- 1 -6.54579E-01 3.31854E-01
- 2 3.21740E-01 2.61530E-01
- 3 4.41461E-02 1.61607E-02
- 4 -1.47027E-01 1.75176E-01
- 5 8.30415E-02 -3.88945E-02
- 6 -1.10139E-01 -1.76884E-01
-6 0 *********** CCCS-his-gly
+4 0 *********** CCCS-asp-thr
+ 1 -7.99522E-01 1.54752E-01
+ 2 -3.92486E-01 1.11183E-03
+ 3 3.69199E-02 -1.83457E-01
+ 4 1.94077E-02 4.26303E-02
+4 0 *********** CCCS-asp-ser
+ 1 -1.25847E+00 -5.72311E-01
+ 2 2.41234E-02 -2.26461E-01
+ 3 2.55803E-01 -1.50901E-01
+ 4 -1.31135E-01 4.34524E-02
+4 0 *********** CCCS-asp-gln
+ 1 -8.42532E-01 4.91175E-02
+ 2 -1.97402E-01 -9.06725E-02
+ 3 -5.70772E-02 -1.42998E-01
+ 4 3.33244E-02 5.77983E-02
+4 0 *********** CCCS-asp-asn
+ 1 -1.01863E+00 -3.89292E-01
+ 2 5.89818E-02 -2.90567E-01
+ 3 1.22241E-01 -5.43853E-02
+ 4 -2.25735E-02 5.73810E-02
+4 0 *********** CCCS-asp-glu
+ 1 -9.17838E-01 1.24982E-01
+ 2 -2.43633E-01 -1.51522E-02
+ 3 -7.86179E-02 -1.80395E-01
+ 4 5.14711E-02 3.89096E-02
+4 0 *********** CCCS-asp-asp
+ 1 -1.12525E+00 -4.49970E-01
+ 2 2.53964E-02 -2.80697E-01
+ 3 1.65651E-01 -4.47945E-02
+ 4 -4.13656E-02 3.97728E-02
+4 0 *********** CCCS-asp-his
+ 1 -1.01495E+00 -3.76970E-01
+ 2 9.53177E-02 -2.00818E-01
+ 3 1.99753E-01 -1.02406E-01
+ 4 -4.17618E-02 4.63318E-03
+4 0 *********** CCCS-asp-arg
+ 1 -5.98206E-01 2.46214E-01
+ 2 -2.08682E-01 2.35004E-01
+ 3 -6.96239E-02 -8.82442E-02
+ 4 9.57137E-03 9.18069E-03
+4 0 *********** CCCS-asp-lys
+ 1 -4.95051E-01 2.98865E-01
+ 2 -3.21343E-01 2.49375E-01
+ 3 5.96272E-03 -8.47740E-02
+ 4 1.62699E-02 1.39569E-02
+4 0 *********** CCCS-asp-pro
+ 1 -1.81100E+00 -4.71232E-01
+ 2 -9.66277E-02 5.29642E-02
+ 3 1.70153E-01 -5.59350E-01
+ 4 -2.69981E-01 7.46327E-02
+4 0 *********** CCCS-his-cys
+ 1 -1.02326E+00 -5.38369E-01
+ 2 -1.32305E-01 -1.06083E-01
+ 3 1.17097E-01 -1.55663E-01
+ 4 -1.53219E-02 7.94010E-02
+4 0 *********** CCCS-his-met
+ 1 -7.26939E-01 -1.67835E-02
+ 2 -2.86022E-01 1.64223E-01
+ 3 6.04967E-02 -1.20698E-01
+ 4 1.14318E-02 4.16890E-02
+4 0 *********** CCCS-his-phe
+ 1 -8.46965E-01 -4.14579E-03
+ 2 -9.31771E-02 3.69304E-01
+ 3 -8.63275E-02 -6.75627E-02
+ 4 6.24307E-02 3.01409E-02
+4 0 *********** CCCS-his-ile
+ 1 -9.33521E-01 -9.30719E-02
+ 2 -4.16225E-01 2.26055E-01
+ 3 8.54612E-02 -1.90131E-01
+ 4 -3.00510E-02 3.43145E-02
+4 0 *********** CCCS-his-leu
+ 1 -6.13861E-01 2.03048E-01
+ 2 -4.71376E-01 4.34944E-01
+ 3 3.79951E-02 -1.01434E-01
+ 4 -6.25438E-03 2.82259E-02
+4 0 *********** CCCS-his-val
+ 1 -8.32966E-01 -4.00007E-02
+ 2 -4.62507E-01 2.88943E-01
+ 3 9.71576E-02 -1.66055E-01
+ 4 -1.14748E-02 2.99271E-02
+4 0 *********** CCCS-his-trp
+ 1 -8.72612E-01 4.41267E-02
+ 2 -1.32333E-01 2.60605E-01
+ 3 -6.21711E-02 -9.47167E-02
+ 4 5.89300E-02 3.00581E-02
+4 0 *********** CCCS-his-tyr
+ 1 -8.33077E-01 5.75024E-03
+ 2 -7.30970E-02 3.43517E-01
+ 3 -9.45024E-02 -6.46969E-02
+ 4 7.58655E-02 3.45212E-02
+4 0 *********** CCCS-his-ala
+ 1 -5.32467E-01 -8.03660E-03
+ 2 -6.24910E-01 -1.79773E-01
+ 3 1.14465E-01 -2.00410E-02
+ 4 -3.26442E-02 -2.13283E-02
+4 0 *********** CCCS-his-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-his-thr
- 1 -7.36235E-01 6.44239E-01
- 2 3.43857E-01 3.50071E-02
- 3 -9.35241E-03 4.74115E-02
- 4 -3.52879E-02 1.29880E-01
- 5 -8.52163E-02 -1.32760E-02
- 6 -2.13888E-02 2.27383E-02
-6 0 *********** CCCS-his-ser
- 1 -1.24130E+00 6.77893E-01
- 2 -6.33190E-04 7.29075E-01
- 3 -2.77197E-01 4.81052E-03
- 4 -1.77465E-01 7.80874E-02
- 5 -1.01869E-01 -3.80840E-02
- 6 -5.42853E-02 -2.16540E-01
-6 0 *********** CCCS-his-gln
- 1 -5.78786E-01 6.46575E-01
- 2 7.65898E-02 2.89929E-01
- 3 -1.61299E-01 -2.34924E-02
- 4 3.21698E-03 8.30028E-02
- 5 -1.44111E-01 -1.29599E-03
- 6 -1.25095E-02 -6.11898E-02
-6 0 *********** CCCS-his-asn
- 1 -9.35299E-01 3.91974E-01
- 2 -2.16197E-01 4.30637E-01
- 3 -2.89033E-01 -4.98258E-02
- 4 -8.33456E-02 4.49129E-02
- 5 -1.03857E-01 -4.67215E-02
- 6 -3.10077E-02 -1.75331E-01
-6 0 *********** CCCS-his-glu
- 1 -5.51318E-01 7.84378E-01
- 2 1.03068E-01 2.57869E-01
- 3 -1.10043E-01 -3.61504E-03
- 4 7.05936E-03 1.02703E-01
- 5 -1.24260E-01 -5.77171E-03
- 6 -9.19900E-03 -3.61945E-02
-6 0 *********** CCCS-his-asp
- 1 -1.20848E+00 1.03365E-01
- 2 2.79780E-02 5.35411E-01
- 3 -1.98611E-01 2.38889E-02
- 4 -1.01629E-01 8.66784E-02
- 5 -1.40819E-01 -4.72075E-03
- 6 -4.95627E-02 -2.14357E-01
-6 0 *********** CCCS-his-his
- 1 -8.11348E-01 6.88261E-01
- 2 -2.66593E-01 3.41290E-01
- 3 -3.05149E-01 2.11946E-02
- 4 -4.71392E-02 3.71800E-02
- 5 -1.41384E-01 -3.97507E-02
- 6 -2.02204E-02 -5.00102E-02
-6 0 *********** CCCS-his-arg
- 1 -2.97511E-01 6.19416E-01
- 2 1.01676E-01 2.40197E-02
- 3 1.74290E-02 -1.27742E-01
- 4 -3.05833E-02 1.08117E-01
- 5 -3.13679E-02 -4.50270E-02
- 6 -3.86925E-02 -7.84691E-02
-6 0 *********** CCCS-his-lys
- 1 -3.34450E-01 6.10628E-01
- 2 1.83074E-01 -5.44541E-02
- 3 6.67447E-03 -8.33039E-02
- 4 2.62249E-02 8.69086E-02
- 5 -9.03792E-02 -4.37099E-02
- 6 9.00931E-03 -1.70582E-02
-6 0 *********** CCCS-his-pro
- 1 1.63748E+00 2.22976E-01
- 2 -7.95758E-01 3.84620E-01
- 3 -9.28068E-01 -2.35653E-01
- 4 -4.29013E-01 3.18648E-01
- 5 3.54836E-01 -2.58958E-01
- 6 -8.05196E-02 -6.34735E-01
-6 0 *********** CCCS-arg-cys
- 1 -7.43848E-01 3.56902E-01
- 2 -8.24121E-02 4.44640E-01
- 3 -1.92858E-01 -4.09616E-02
- 4 -1.14124E-01 8.17029E-02
- 5 -8.58320E-02 -3.10637E-02
- 6 -5.56628E-02 -1.94905E-01
-6 0 *********** CCCS-arg-met
- 1 -5.14149E-01 4.85539E-01
- 2 1.94901E-01 1.02124E-01
- 3 -9.72442E-02 -5.12524E-03
- 4 5.67349E-03 8.23158E-02
- 5 -1.14161E-01 -1.44556E-02
- 6 -6.32732E-03 -3.11200E-02
-6 0 *********** CCCS-arg-phe
- 1 -4.37007E-01 6.06687E-01
- 2 1.53928E-01 4.63906E-03
- 3 -5.53030E-02 -8.77631E-02
- 4 -2.75897E-02 6.84397E-02
- 5 -6.00834E-02 -3.91405E-02
- 6 -2.62217E-02 -2.86815E-02
-6 0 *********** CCCS-arg-ile
- 1 -5.40411E-01 5.94259E-01
- 2 2.37999E-01 6.11202E-02
- 3 -1.07228E-01 5.86885E-02
- 4 5.02940E-02 8.13752E-02
- 5 -1.52822E-01 -6.44111E-03
- 6 2.04929E-02 4.45662E-02
-6 0 *********** CCCS-arg-leu
- 1 -4.21968E-01 5.39220E-01
- 2 3.48265E-01 -5.91477E-02
- 3 8.64748E-02 -5.23617E-02
- 4 -2.84161E-02 9.04500E-02
- 5 4.26981E-02 -5.29290E-02
- 6 -2.66049E-02 -2.32063E-02
-6 0 *********** CCCS-arg-val
- 1 -4.93698E-01 5.82116E-01
- 2 2.31842E-01 -1.57760E-02
- 3 -5.50727E-02 3.82381E-02
- 4 2.55357E-03 8.66277E-02
- 5 -9.48211E-02 -1.82950E-02
- 6 -3.51998E-03 4.60979E-02
-6 0 *********** CCCS-arg-trp
- 1 -4.10329E-01 5.74620E-01
- 2 1.48736E-01 7.62777E-02
- 3 -7.32776E-02 -6.34433E-02
- 4 -2.48010E-02 7.45463E-02
- 5 -6.72253E-02 -3.16917E-02
- 6 -2.52669E-02 -3.61220E-02
-6 0 *********** CCCS-arg-tyr
- 1 -4.13258E-01 5.83099E-01
- 2 1.14583E-01 3.84648E-02
- 3 -2.79029E-02 -1.23228E-01
- 4 -7.83538E-02 9.33207E-02
- 5 -4.35886E-03 -5.31921E-02
- 6 -5.94226E-02 -8.40323E-02
-6 0 *********** CCCS-arg-ala
- 1 -6.63524E-01 1.88102E-01
- 2 3.25433E-01 3.91884E-01
- 3 -2.77289E-02 4.00158E-03
- 4 -1.51767E-01 1.86905E-01
- 5 5.18823E-02 -3.15322E-02
- 6 -1.21096E-01 -2.53706E-01
-6 0 *********** CCCS-arg-gly
+4 0 *********** CCCS-his-thr
+ 1 -8.64016E-01 -5.70001E-02
+ 2 -4.14313E-01 5.71780E-02
+ 3 8.06841E-02 -1.11773E-01
+ 4 -2.45426E-02 1.30547E-02
+4 0 *********** CCCS-his-ser
+ 1 -1.18836E+00 -1.02027E+00
+ 2 -3.02832E-02 -1.63870E-01
+ 3 5.58247E-02 -1.64973E-01
+ 4 -1.26828E-02 3.25314E-02
+4 0 *********** CCCS-his-gln
+ 1 -8.82102E-01 -1.08999E-01
+ 2 -2.02016E-01 -7.18844E-02
+ 3 -7.27482E-02 -9.03949E-02
+ 4 2.13206E-02 5.10057E-02
+4 0 *********** CCCS-his-asn
+ 1 -9.72049E-01 -6.32958E-01
+ 2 5.23451E-02 -2.54655E-01
+ 3 -6.29446E-03 -7.50023E-02
+ 4 5.00907E-02 6.28422E-02
+4 0 *********** CCCS-his-glu
+ 1 -9.90556E-01 -7.69450E-02
+ 2 -2.40946E-01 3.04749E-02
+ 3 -6.43926E-02 -1.15558E-01
+ 4 1.53074E-02 2.73723E-02
+4 0 *********** CCCS-his-asp
+ 1 -1.06972E+00 -7.81364E-01
+ 2 -2.56562E-02 -2.26331E-01
+ 3 1.76280E-02 -3.63538E-02
+ 4 6.90605E-02 3.88689E-02
+4 0 *********** CCCS-his-his
+ 1 -1.01054E+00 -5.91953E-01
+ 2 1.27013E-01 -1.18587E-01
+ 3 1.17117E-01 -1.66741E-01
+ 4 -3.66351E-05 -6.02392E-03
+4 0 *********** CCCS-his-arg
+ 1 -6.86245E-01 1.26500E-01
+ 2 -2.16154E-01 2.92860E-01
+ 3 -1.88657E-02 -1.01456E-01
+ 4 -1.30023E-02 2.10232E-02
+4 0 *********** CCCS-his-lys
+ 1 -5.72868E-01 1.92764E-01
+ 2 -3.51296E-01 2.95718E-01
+ 3 6.67583E-02 -9.19463E-02
+ 4 5.95436E-03 1.30736E-02
+4 0 *********** CCCS-his-pro
+ 1 -1.81088E+00 -9.62880E-01
+ 2 -4.13290E-02 1.60325E-01
+ 3 -8.38799E-02 -3.98468E-01
+ 4 -1.26949E-01 6.56677E-02
+4 0 *********** CCCS-arg-cys
+ 1 -8.60019E-01 -4.02387E-01
+ 2 1.05000E-01 -3.71651E-02
+ 3 9.80543E-02 -9.57294E-02
+ 4 4.32441E-03 2.62327E-02
+4 0 *********** CCCS-arg-met
+ 1 -6.00045E-01 4.21913E-02
+ 2 -1.25392E-01 -3.14466E-02
+ 3 2.00347E-02 -5.65546E-02
+ 4 -1.25662E-02 4.42769E-02
+4 0 *********** CCCS-arg-phe
+ 1 -6.36634E-01 1.05698E-01
+ 2 -7.57701E-02 7.34952E-02
+ 3 -1.02513E-01 -3.72951E-02
+ 4 4.71804E-02 5.49243E-02
+4 0 *********** CCCS-arg-ile
+ 1 -7.57767E-01 3.93647E-02
+ 2 -1.35431E-01 -6.39326E-02
+ 3 1.45340E-02 -1.04796E-01
+ 4 -4.19706E-02 3.75250E-02
+4 0 *********** CCCS-arg-leu
+ 1 -5.26314E-01 2.56016E-01
+ 2 -2.72982E-01 3.62919E-02
+ 3 -2.01340E-02 -4.05168E-02
+ 4 -2.83457E-02 8.83989E-02
+4 0 *********** CCCS-arg-val
+ 1 -6.74523E-01 8.80890E-02
+ 2 -1.91585E-01 -3.94856E-02
+ 3 1.47026E-02 -8.64697E-02
+ 4 -3.60785E-02 6.07020E-02
+4 0 *********** CCCS-arg-trp
+ 1 -6.83791E-01 1.17301E-01
+ 2 -7.07344E-02 1.26248E-02
+ 3 -6.78684E-02 -4.78957E-02
+ 4 3.37021E-02 4.63795E-02
+4 0 *********** CCCS-arg-tyr
+ 1 -6.27300E-01 1.01348E-01
+ 2 -6.73912E-02 7.15082E-02
+ 3 -9.90035E-02 -3.67426E-02
+ 4 5.00826E-02 5.62243E-02
+4 0 *********** CCCS-arg-ala
+ 1 -4.82163E-01 8.76203E-03
+ 2 -2.13478E-01 -2.22078E-01
+ 3 5.66511E-02 -1.93504E-02
+ 4 -6.32620E-02 -7.50769E-02
+4 0 *********** CCCS-arg-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-arg-thr
- 1 -7.91994E-01 4.26935E-01
- 2 4.55623E-01 1.88859E-01
- 3 -1.52123E-01 5.50360E-02
- 4 3.11653E-02 1.10653E-01
- 5 -1.64886E-01 7.09059E-03
- 6 1.31920E-03 -2.85022E-02
-6 0 *********** CCCS-arg-ser
- 1 -9.59538E-01 1.82115E-01
- 2 -1.88992E-01 9.09706E-01
- 3 -1.80032E-01 -7.58705E-02
- 4 -2.34529E-01 6.24999E-02
- 5 -2.50220E-02 -6.07513E-02
- 6 -7.78592E-02 -4.04287E-01
-6 0 *********** CCCS-arg-gln
- 1 -5.90155E-01 4.33470E-01
- 2 1.01846E-01 3.31759E-01
- 3 -1.64869E-01 8.35225E-04
- 4 -2.25878E-02 7.47515E-02
- 5 -1.38890E-01 -3.62787E-03
- 6 -1.64462E-02 -9.31211E-02
-6 0 *********** CCCS-arg-asn
- 1 -7.43507E-01 1.54914E-01
- 2 -3.44468E-01 4.41200E-01
- 3 -2.36984E-01 -1.02789E-01
- 4 -1.08856E-01 5.65673E-02
- 5 -3.52958E-02 -6.42720E-02
- 6 -6.14817E-02 -2.64753E-01
-6 0 *********** CCCS-arg-glu
- 1 -5.95159E-01 5.22574E-01
- 2 1.78679E-01 3.18022E-01
- 3 -1.49200E-01 3.62404E-02
- 4 -1.39426E-02 8.49471E-02
- 5 -1.26580E-01 -4.83751E-04
- 6 -1.60877E-02 -6.47144E-02
-6 0 *********** CCCS-arg-asp
- 1 -8.74890E-01 -7.94188E-02
- 2 -2.30159E-01 5.51661E-01
- 3 -1.52693E-01 1.46517E-02
- 4 -1.10047E-01 5.21758E-02
- 5 -1.04372E-01 -3.47834E-02
- 6 -5.48866E-02 -2.65595E-01
-6 0 *********** CCCS-arg-his
- 1 -6.75499E-01 3.74803E-01
- 2 -2.91058E-01 3.70037E-01
- 3 -3.17633E-01 -8.96044E-03
- 4 -2.67837E-02 2.42223E-02
- 5 -1.30398E-01 -4.07534E-02
- 6 -1.86325E-02 -1.23619E-01
-6 0 *********** CCCS-arg-arg
- 1 -3.86964E-01 4.83295E-01
- 2 1.86480E-01 5.06476E-02
- 3 -6.73451E-04 -6.88351E-02
- 4 -4.32170E-02 9.86422E-02
- 5 -2.48919E-02 -4.35227E-02
- 6 -3.54270E-02 -7.29040E-02
-6 0 *********** CCCS-arg-lys
- 1 -4.20647E-01 4.80757E-01
- 2 2.65916E-01 -8.29208E-03
- 3 -1.85791E-02 -2.87947E-02
- 4 1.04131E-02 7.39742E-02
- 5 -6.86880E-02 -3.30806E-02
- 6 -6.07656E-04 -7.68201E-03
-6 0 *********** CCCS-arg-pro
- 1 9.74926E-01 5.19788E-01
- 2 -1.12683E+00 -1.72420E-01
- 3 -6.07089E-01 -8.60284E-01
- 4 -3.03973E-02 3.61044E-01
- 5 2.29955E-01 1.42384E-01
- 6 -2.56288E-01 -4.13432E-01
-6 0 *********** CCCS-lys-cys
- 1 -6.02230E-01 3.01995E-03
- 2 -2.98937E-02 5.17508E-01
- 3 -2.03256E-01 -5.36881E-02
- 4 -1.25282E-01 1.07190E-01
- 5 -6.94863E-02 -4.87774E-02
- 6 -6.81029E-02 -3.11690E-01
-6 0 *********** CCCS-lys-met
- 1 -5.22133E-01 2.39517E-01
- 2 2.59735E-01 1.16388E-01
- 3 -1.03895E-01 1.55879E-02
- 4 -6.12132E-04 7.09196E-02
- 5 -9.93577E-02 -1.05688E-02
- 6 -1.32654E-02 -5.42909E-02
-6 0 *********** CCCS-lys-phe
- 1 -4.95423E-01 3.45034E-01
- 2 2.49802E-01 -1.99069E-02
- 3 -4.15070E-02 -4.97516E-02
- 4 6.99357E-03 6.43529E-02
- 5 -9.28881E-02 -3.58657E-02
- 6 -7.42763E-04 -3.03637E-02
-6 0 *********** CCCS-lys-ile
- 1 -5.80792E-01 3.02283E-01
- 2 3.40828E-01 8.04031E-02
- 3 -1.53491E-01 8.43189E-02
- 4 4.63538E-02 4.42798E-02
- 5 -1.22754E-01 6.87427E-03
- 6 5.36731E-03 3.93173E-02
-6 0 *********** CCCS-lys-leu
- 1 -5.18717E-01 3.38804E-01
- 2 4.03546E-01 -6.67436E-02
- 3 9.16556E-02 -2.75418E-02
- 4 -3.87499E-02 8.93877E-02
- 5 4.88300E-02 -5.27869E-02
- 6 -3.02332E-02 -3.82412E-02
-6 0 *********** CCCS-lys-val
- 1 -5.44447E-01 3.13960E-01
- 2 3.27461E-01 1.46123E-02
- 3 -1.08087E-01 3.76512E-02
- 4 1.75716E-02 5.51607E-02
- 5 -8.01396E-02 -8.14887E-03
- 6 -8.78334E-03 1.82321E-02
-6 0 *********** CCCS-lys-trp
- 1 -4.65195E-01 3.09005E-01
- 2 2.25634E-01 5.40043E-02
- 3 -4.22891E-02 -3.71968E-02
- 4 -2.51112E-02 7.62059E-02
- 5 -6.11602E-02 -3.41142E-02
- 6 -2.07623E-02 -6.61822E-02
-6 0 *********** CCCS-lys-tyr
- 1 -4.65511E-01 3.29194E-01
- 2 2.07270E-01 3.25418E-03
- 3 -1.43564E-02 -7.59897E-02
- 4 -3.75895E-02 8.22471E-02
- 5 -4.83579E-02 -4.68575E-02
- 6 -2.70825E-02 -7.62800E-02
-6 0 *********** CCCS-lys-ala
- 1 -6.35930E-01 2.65608E-02
- 2 3.59546E-01 4.19819E-01
- 3 -8.84120E-02 2.55692E-02
- 4 -1.36443E-01 1.67481E-01
- 5 2.61108E-02 -2.38085E-02
- 6 -1.14583E-01 -2.56733E-01
-6 0 *********** CCCS-lys-gly
+4 0 *********** CCCS-arg-thr
+ 1 -7.41292E-01 1.79491E-02
+ 2 -1.14110E-01 -1.12274E-01
+ 3 2.09531E-02 -7.55140E-02
+ 4 -4.83518E-02 7.54308E-03
+4 0 *********** CCCS-arg-ser
+ 1 -1.08178E+00 -7.42395E-01
+ 2 2.36169E-01 1.54880E-01
+ 3 1.50230E-01 -1.86019E-01
+ 4 9.56662E-03 2.35742E-02
+4 0 *********** CCCS-arg-gln
+ 1 -7.63714E-01 -7.13278E-02
+ 2 -2.44959E-04 -1.02773E-01
+ 3 -2.83988E-02 -1.04252E-01
+ 4 -2.19452E-02 1.74852E-02
+4 0 *********** CCCS-arg-asn
+ 1 -8.44769E-01 -5.28407E-01
+ 2 1.94637E-01 -5.37759E-03
+ 3 6.93261E-02 -8.06881E-02
+ 4 4.46814E-02 4.06136E-02
+4 0 *********** CCCS-arg-glu
+ 1 -8.41862E-01 -1.32649E-02
+ 2 -1.56056E-02 -9.31546E-02
+ 3 -4.46320E-02 -1.08568E-01
+ 4 -1.99048E-02 8.70813E-03
+4 0 *********** CCCS-arg-asp
+ 1 -9.40580E-01 -5.94497E-01
+ 2 2.07471E-01 3.22621E-02
+ 3 7.42922E-02 -9.60415E-02
+ 4 5.22099E-02 3.43707E-02
+4 0 *********** CCCS-arg-his
+ 1 -8.12781E-01 -5.04109E-01
+ 2 1.78450E-01 1.32505E-02
+ 3 1.24235E-01 -5.28164E-02
+ 4 5.58702E-02 -9.35862E-03
+4 0 *********** CCCS-arg-arg
+ 1 -5.62345E-01 1.68355E-01
+ 2 -1.40534E-01 3.26282E-02
+ 3 -3.29850E-02 -4.82963E-02
+ 4 -6.41402E-03 3.43577E-02
+4 0 *********** CCCS-arg-lys
+ 1 -4.88191E-01 2.13645E-01
+ 2 -2.11967E-01 1.95535E-02
+ 3 1.16384E-02 -2.24441E-02
+ 4 -8.30089E-03 4.76400E-02
+4 0 *********** CCCS-arg-pro
+ 1 -1.55006E+00 -5.29384E-01
+ 2 4.43655E-01 1.48509E-01
+ 3 -1.04577E-01 -4.50797E-01
+ 4 -4.92987E-02 5.37380E-02
+4 0 *********** CCCS-lys-cys
+ 1 -8.57945E-01 -3.73314E-01
+ 2 1.14933E-01 -2.11371E-02
+ 3 8.36268E-02 -1.02175E-01
+ 4 1.06463E-02 2.13660E-02
+4 0 *********** CCCS-lys-met
+ 1 -5.89273E-01 6.23451E-02
+ 2 -1.04779E-01 -3.04958E-02
+ 3 1.01108E-02 -5.32766E-02
+ 4 -8.64647E-03 4.27045E-02
+4 0 *********** CCCS-lys-phe
+ 1 -6.22741E-01 1.30188E-01
+ 2 -5.64494E-02 5.91916E-02
+ 3 -1.03939E-01 -2.61833E-02
+ 4 5.14258E-02 5.05484E-02
+4 0 *********** CCCS-lys-ile
+ 1 -7.47930E-01 6.24236E-02
+ 2 -1.06004E-01 -6.04978E-02
+ 3 -5.71686E-04 -9.85706E-02
+ 4 -4.01148E-02 3.79531E-02
+4 0 *********** CCCS-lys-leu
+ 1 -5.15368E-01 2.67874E-01
+ 2 -2.39334E-01 3.11397E-02
+ 3 -2.58942E-02 -3.37048E-02
+ 4 -1.85408E-02 9.02257E-02
+4 0 *********** CCCS-lys-val
+ 1 -6.64281E-01 1.08775E-01
+ 2 -1.60067E-01 -3.75534E-02
+ 3 1.05717E-03 -8.08583E-02
+ 4 -3.17826E-02 6.07997E-02
+4 0 *********** CCCS-lys-trp
+ 1 -6.68837E-01 1.40711E-01
+ 2 -5.24290E-02 3.18997E-03
+ 3 -7.20523E-02 -3.78172E-02
+ 4 3.65417E-02 4.20063E-02
+4 0 *********** CCCS-lys-tyr
+ 1 -6.13091E-01 1.25364E-01
+ 2 -4.95788E-02 5.75949E-02
+ 3 -1.00299E-01 -2.58421E-02
+ 4 5.43450E-02 5.10909E-02
+4 0 *********** CCCS-lys-ala
+ 1 -4.77878E-01 1.91412E-02
+ 2 -1.91670E-01 -1.94850E-01
+ 3 4.91807E-02 -2.44385E-02
+ 4 -7.07822E-02 -6.64245E-02
+4 0 *********** CCCS-lys-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-lys-thr
- 1 -7.50639E-01 1.74206E-01
- 2 4.90877E-01 2.46492E-01
- 3 -1.67962E-01 5.84114E-02
- 4 4.15554E-02 1.06409E-01
- 5 -1.81180E-01 1.69280E-02
- 6 4.69751E-03 -8.42133E-02
-6 0 *********** CCCS-lys-ser
- 1 -7.66887E-01 -1.96177E-01
- 2 -1.02778E-01 9.24461E-01
- 3 -2.54621E-01 -5.57384E-02
- 4 -2.08148E-01 1.14874E-01
- 5 -1.09620E-02 -9.32760E-02
- 6 -1.03855E-01 -5.26694E-01
-6 0 *********** CCCS-lys-gln
- 1 -5.45066E-01 1.42537E-01
- 2 1.58834E-01 3.37685E-01
- 3 -1.51041E-01 4.17064E-02
- 4 -4.26816E-02 7.49185E-02
- 5 -1.21478E-01 -4.70664E-03
- 6 -2.75753E-02 -1.28892E-01
-6 0 *********** CCCS-lys-asn
- 1 -5.28592E-01 -1.30237E-01
- 2 -3.39344E-01 5.03292E-01
- 3 -2.42832E-01 -1.45713E-01
- 4 -1.27021E-01 7.00802E-02
- 5 -1.88622E-02 -6.96551E-02
- 6 -6.96779E-02 -3.71631E-01
-6 0 *********** CCCS-lys-glu
- 1 -5.86733E-01 1.98662E-01
- 2 2.55789E-01 3.13409E-01
- 3 -1.38397E-01 8.81366E-02
- 4 -4.08687E-02 6.57991E-02
- 5 -9.08640E-02 1.12822E-02
- 6 -3.58259E-02 -6.27429E-02
-6 0 *********** CCCS-lys-asp
- 1 -6.01818E-01 -2.41511E-01
- 2 -2.47820E-01 5.85543E-01
- 3 -2.34350E-01 -3.32414E-02
- 4 -1.05742E-01 5.49222E-02
- 5 -9.48059E-02 -4.46984E-02
- 6 -4.52813E-02 -3.30641E-01
-6 0 *********** CCCS-lys-his
- 1 -4.95835E-01 2.82517E-02
- 2 -2.29881E-01 4.26648E-01
- 3 -3.56636E-01 -2.62411E-02
- 4 -1.52709E-02 1.83840E-02
- 5 -1.52950E-01 -3.06618E-02
- 6 -2.78739E-03 -1.90989E-01
-6 0 *********** CCCS-lys-arg
- 1 -4.46965E-01 2.77001E-01
- 2 2.51039E-01 3.41170E-02
- 3 9.21583E-04 -3.41144E-02
- 4 -4.34806E-02 9.03882E-02
- 5 -2.72861E-02 -4.46405E-02
- 6 -2.88453E-02 -8.04451E-02
-6 0 *********** CCCS-lys-lys
- 1 -4.77369E-01 2.86128E-01
- 2 3.16700E-01 -1.04528E-02
- 3 -1.50073E-02 -6.34081E-03
- 4 -3.07878E-03 6.75630E-02
- 5 -5.21673E-02 -3.25405E-02
- 6 -8.05653E-03 -2.28501E-02
-6 0 *********** CCCS-lys-pro
- 1 7.81033E-01 3.86633E-01
- 2 -8.85961E-01 -1.97254E-01
- 3 -5.86614E-01 -4.32830E-01
- 4 -3.27302E-01 7.08707E-01
- 5 -4.36193E-02 3.08966E-01
- 6 -3.54830E-01 -3.11488E-01
-6 0 *********** CCCS-pro-cys
- 1 9.85489E-01 2.36991E-01
- 2 -3.54985E-03 2.93726E-03
- 3 -1.54961E-01 -2.06716E-01
- 4 -6.04452E-02 2.32695E-01
- 5 1.66816E-01 -5.35372E-02
- 6 -5.49626E-02 -2.62096E-01
-6 0 *********** CCCS-pro-met
- 1 5.54373E-01 -2.19283E-01
- 2 4.93476E-02 2.99992E-01
- 3 -5.81622E-02 3.90212E-02
- 4 7.84420E-02 8.76785E-02
- 5 1.71796E-02 -6.29924E-02
- 6 -3.01909E-02 -2.29831E-01
-6 0 *********** CCCS-pro-phe
- 1 5.83641E-01 -3.12690E-01
- 2 3.67635E-01 3.25859E-01
- 3 -6.02619E-02 -1.03419E-01
- 4 4.11098E-02 -1.76950E-02
- 5 -7.36235E-02 -5.01435E-02
- 6 -1.32399E-03 -2.42767E-01
-6 0 *********** CCCS-pro-ile
- 1 7.23878E-01 -3.13312E-01
- 2 1.59590E-01 2.90108E-01
- 3 -1.78930E-02 3.44547E-01
- 4 3.41762E-01 8.31147E-02
- 5 -2.02750E-01 -3.63193E-02
- 6 4.53851E-02 -6.84121E-02
-6 0 *********** CCCS-pro-leu
- 1 2.93568E-01 -5.44251E-01
- 2 9.03241E-02 7.06069E-01
- 3 3.11071E-02 1.66763E-01
- 4 1.42547E-01 -6.09245E-02
- 5 -1.50809E-01 3.46120E-02
- 6 7.52883E-02 -1.75628E-01
-6 0 *********** CCCS-pro-val
- 1 6.47938E-01 -3.76160E-01
- 2 1.32510E-01 4.84379E-01
- 3 4.78833E-02 2.61158E-01
- 4 9.24696E-02 2.34331E-01
- 5 4.00620E-02 -1.20910E-01
- 6 -1.12681E-01 -3.55874E-01
-6 0 *********** CCCS-pro-trp
- 1 5.39977E-01 -3.01300E-01
- 2 2.82541E-01 2.08083E-01
- 3 -1.56150E-01 -3.33156E-02
- 4 1.28191E-01 -4.32846E-02
- 5 -1.85930E-01 -8.52603E-03
- 6 6.65920E-02 -1.19828E-01
-6 0 *********** CCCS-pro-tyr
- 1 5.67567E-01 -3.09601E-01
- 2 3.68313E-01 2.91200E-01
- 3 -7.23925E-02 -1.27058E-01
- 4 4.00739E-02 -2.23247E-02
- 5 -6.15331E-02 -6.03706E-02
- 6 2.62971E-03 -2.43875E-01
-6 0 *********** CCCS-pro-ala
- 1 5.71181E-01 -2.05709E-01
- 2 -5.21818E-01 3.59463E-01
- 3 -2.25054E-01 3.44062E-01
- 4 5.92711E-02 3.13742E-01
- 5 -1.21830E-01 -9.66926E-02
- 6 -1.72966E-01 -2.78257E-01
-6 0 *********** CCCS-pro-gly
+4 0 *********** CCCS-lys-thr
+ 1 -7.32265E-01 3.88917E-02
+ 2 -8.93353E-02 -1.02472E-01
+ 3 8.47632E-03 -7.36822E-02
+ 4 -4.89634E-02 1.09405E-02
+4 0 *********** CCCS-lys-ser
+ 1 -1.09042E+00 -7.13201E-01
+ 2 2.37665E-01 1.82376E-01
+ 3 1.42143E-01 -2.00704E-01
+ 4 7.02171E-03 2.05770E-02
+4 0 *********** CCCS-lys-gln
+ 1 -7.55053E-01 -4.83876E-02
+ 2 1.35247E-02 -9.34263E-02
+ 3 -3.62364E-02 -9.91817E-02
+ 4 -2.13951E-02 1.67911E-02
+4 0 *********** CCCS-lys-asn
+ 1 -8.44846E-01 -5.00831E-01
+ 2 1.90252E-01 1.19835E-02
+ 3 6.41052E-02 -8.56566E-02
+ 4 4.98239E-02 3.25985E-02
+4 0 *********** CCCS-lys-glu
+ 1 -8.31436E-01 1.12945E-02
+ 2 3.97508E-03 -8.80877E-02
+ 3 -5.42010E-02 -1.00588E-01
+ 4 -2.13442E-02 8.60120E-03
+4 0 *********** CCCS-lys-asp
+ 1 -9.42319E-01 -5.64401E-01
+ 2 2.07072E-01 5.29345E-02
+ 3 6.84183E-02 -1.05422E-01
+ 4 5.47873E-02 2.86901E-02
+4 0 *********** CCCS-lys-his
+ 1 -8.09040E-01 -4.76061E-01
+ 2 1.72341E-01 2.31401E-02
+ 3 1.15193E-01 -5.76260E-02
+ 4 5.67028E-02 -1.78136E-02
+4 0 *********** CCCS-lys-arg
+ 1 -5.48948E-01 1.85786E-01
+ 2 -1.20092E-01 2.45507E-02
+ 3 -3.73639E-02 -4.06512E-02
+ 4 -3.63217E-03 3.57043E-02
+4 0 *********** CCCS-lys-lys
+ 1 -4.75770E-01 2.26095E-01
+ 2 -1.86851E-01 1.58762E-02
+ 3 5.05309E-03 -1.86031E-02
+ 4 -3.81038E-03 4.80344E-02
+4 0 *********** CCCS-lys-pro
+ 1 -1.58797E+00 -5.01675E-01
+ 2 4.92487E-01 2.05297E-01
+ 3 -1.27315E-01 -4.64023E-01
+ 4 -4.01578E-02 6.91176E-02
+4 0 *********** CCCS-pro-cys
+ 1 -1.17004E+00 -3.98677E-01
+ 2 -1.60362E-01 -1.93996E-01
+ 3 1.73518E-01 -8.37873E-02
+ 4 -5.92099E-02 1.18630E-01
+4 0 *********** CCCS-pro-met
+ 1 -7.48336E-01 6.07604E-02
+ 2 -2.78999E-01 1.90683E-01
+ 3 7.17836E-02 -1.43945E-01
+ 4 1.91651E-02 2.55350E-02
+4 0 *********** CCCS-pro-phe
+ 1 -8.80193E-01 6.47252E-02
+ 2 -4.88850E-02 4.12591E-01
+ 3 -7.20780E-02 -1.11166E-01
+ 4 2.58254E-02 1.63394E-02
+4 0 *********** CCCS-pro-ile
+ 1 -9.79710E-01 3.99701E-02
+ 2 -4.71326E-01 2.74523E-01
+ 3 1.27845E-01 -2.67378E-01
+ 4 2.82929E-02 2.00015E-02
+4 0 *********** CCCS-pro-leu
+ 1 -6.00811E-01 3.27666E-01
+ 2 -4.91996E-01 5.51639E-01
+ 3 3.84590E-03 -1.80629E-01
+ 4 -9.86790E-03 -7.49951E-02
+4 0 *********** CCCS-pro-val
+ 1 -8.68898E-01 7.17527E-02
+ 2 -5.01002E-01 3.63549E-01
+ 3 1.32046E-01 -2.50488E-01
+ 4 2.93732E-02 -1.61536E-02
+4 0 *********** CCCS-pro-trp
+ 1 -8.96501E-01 1.29992E-01
+ 2 -1.11580E-01 2.84068E-01
+ 3 -4.59362E-02 -1.25418E-01
+ 4 4.37184E-02 1.50829E-02
+4 0 *********** CCCS-pro-tyr
+ 1 -8.61402E-01 7.45852E-02
+ 2 -3.14205E-02 3.78266E-01
+ 3 -8.06996E-02 -9.94746E-02
+ 4 4.14958E-02 1.80331E-02
+4 0 *********** CCCS-pro-ala
+ 1 -5.62598E-01 1.11374E-01
+ 2 -7.45549E-01 -1.31464E-01
+ 3 1.61317E-01 -8.42793E-02
+ 4 8.72320E-02 2.91395E-02
+4 0 *********** CCCS-pro-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** CCCS-pro-thr
- 1 6.77401E-01 -1.01188E-01
- 2 -1.81642E-01 4.22454E-01
- 3 -4.19218E-01 3.96677E-01
- 4 3.91292E-01 1.98865E-01
- 5 -2.52456E-01 3.08293E-02
- 6 -4.27044E-03 -6.59051E-02
-6 0 *********** CCCS-pro-ser
- 1 1.53317E+00 5.10759E-01
- 2 -2.70759E-01 -2.48493E-01
- 3 -1.81702E-01 -4.68519E-01
- 4 -2.05150E-01 4.19572E-01
- 5 2.30890E-01 -2.40943E-02
- 6 -1.04744E-01 -3.62058E-01
-6 0 *********** CCCS-pro-gln
- 1 7.22871E-01 -6.27080E-02
- 2 -1.01971E-01 9.23786E-02
- 3 -1.24258E-01 -1.57409E-01
- 4 2.43517E-02 6.37344E-02
- 5 3.84116E-02 -8.32489E-02
- 6 -4.33634E-02 -2.31576E-01
-6 0 *********** CCCS-pro-asn
- 1 7.94779E-01 5.09708E-01
- 2 2.46870E-03 -2.00313E-01
- 3 -2.64321E-01 -3.75280E-01
- 4 -2.29648E-01 1.20667E-01
- 5 2.16590E-01 -5.28920E-02
- 6 -8.91820E-02 -1.62325E-01
-6 0 *********** CCCS-pro-glu
- 1 8.44383E-01 -1.95329E-01
- 2 -9.59194E-02 1.44007E-01
- 3 -5.28421E-02 -5.98437E-02
- 4 5.06929E-02 1.39596E-02
- 5 -1.13456E-02 -3.84390E-02
- 6 1.87859E-03 -1.51952E-01
-6 0 *********** CCCS-pro-asp
- 1 7.47317E-01 8.75282E-01
- 2 -4.56803E-01 -6.99672E-02
- 3 -3.78971E-01 -1.66435E-01
- 4 -2.98850E-01 3.74484E-01
- 5 1.67122E-01 6.92699E-03
- 6 -1.86486E-02 -1.56816E-01
-6 0 *********** CCCS-pro-his
- 1 1.08803E+00 2.83710E-01
- 2 2.30702E-01 -3.33208E-01
- 3 -1.42208E-01 -1.02947E-01
- 4 -1.28065E-01 1.61761E-01
- 5 1.14187E-01 -3.77072E-03
- 6 -6.54468E-03 -1.05903E-02
-6 0 *********** CCCS-pro-arg
- 1 3.76675E-01 -3.47703E-01
- 2 1.35347E-01 3.78398E-01
- 3 -3.97333E-02 -1.13018E-02
- 4 7.84527E-02 5.99127E-02
- 5 -1.27380E-02 -2.33781E-02
- 6 1.68766E-02 -2.51341E-01
-6 0 *********** CCCS-pro-lys
- 1 3.39222E-01 -3.63671E-01
- 2 9.82634E-02 4.51786E-01
- 3 -4.22663E-02 7.95077E-02
- 4 9.36551E-02 4.56777E-02
- 5 -7.88015E-02 -1.11361E-02
- 6 1.11646E-02 -2.12075E-01
-6 0 *********** CCCS-pro-pro
- 1 -2.27321E+01 -3.85657E+01
- 2 1.58666E+01 -2.88802E+01
- 3 1.67971E+01 -8.07390E-01
- 4 9.30424E-01 2.13176E-01
- 5 5.93499E+00 -9.47235E+00
- 6 7.74876E+00 -5.66348E+00
-6 0 *********** SCCS-cys-cys
- 1 -7.24207E-01 -1.97690E-01
- 2 4.25695E-01 1.80088E-01
- 3 -7.62180E-02 1.36323E-02
- 4 3.01988E-02 4.19477E-02
- 5 -6.48082E-02 -6.45251E-04
- 6 -3.37999E-03 -1.16879E-01
-6 0 *********** SCCS-cys-met
- 1 -4.74043E-01 2.34199E-02
- 2 1.69564E-01 -1.20052E-01
- 3 -2.81536E-02 -9.54968E-02
- 4 -3.95379E-02 4.44851E-02
- 5 -5.31490E-02 -4.84258E-02
- 6 -2.78679E-02 -7.84298E-02
-6 0 *********** SCCS-cys-phe
- 1 -4.28325E-01 7.11343E-02
- 2 5.98883E-02 -1.21511E-01
- 3 -4.03328E-02 -2.75259E-01
- 4 -1.37120E-01 7.50094E-02
- 5 -9.18229E-03 -5.88630E-02
- 6 -7.73522E-02 -1.86927E-01
-6 0 *********** SCCS-cys-ile
- 1 -4.83671E-01 -3.86853E-03
- 2 1.88503E-01 -9.66789E-02
- 3 -6.17656E-02 -4.35353E-02
- 4 -6.04741E-02 4.09216E-02
- 5 -2.02603E-02 -4.76066E-02
- 6 -4.95882E-02 -5.95856E-02
-6 0 *********** SCCS-cys-leu
- 1 -4.70839E-01 1.57622E-01
- 2 8.65584E-02 -2.90285E-01
- 3 1.67944E-02 -1.81989E-01
- 4 -3.86066E-02 6.78994E-02
- 5 -1.28352E-01 -7.91449E-02
- 6 -8.17046E-03 -7.97987E-02
-6 0 *********** SCCS-cys-val
- 1 -5.00810E-01 8.03782E-02
- 2 1.61448E-01 -2.02250E-01
- 3 -1.61346E-02 -8.88929E-02
- 4 -1.25880E-01 5.04734E-02
- 5 1.37057E-03 -5.72010E-02
- 6 -7.30767E-02 -4.87715E-02
-6 0 *********** SCCS-cys-trp
- 1 -4.52842E-01 9.34890E-03
- 2 1.53365E-01 -9.14273E-02
- 3 -9.37907E-02 -1.05503E-01
- 4 -1.32488E-02 2.65187E-02
- 5 -9.45935E-02 -3.75617E-02
- 6 -2.25340E-02 -7.13783E-02
-6 0 *********** SCCS-cys-tyr
- 1 -3.84907E-01 7.98579E-02
- 2 2.44854E-02 -1.41959E-01
- 3 -6.73799E-02 -2.31806E-01
- 4 -1.17880E-01 6.50487E-02
- 5 -2.62425E-02 -6.95007E-02
- 6 -8.04802E-02 -1.62863E-01
-6 0 *********** SCCS-cys-ala
- 1 -5.59066E-01 -2.41275E-02
- 2 3.19831E-01 -1.17360E-01
- 3 -4.96253E-02 8.56232E-02
- 4 6.39408E-02 5.22274E-02
- 5 -1.36277E-01 -1.12869E-02
- 6 7.09482E-03 3.07324E-02
-6 0 *********** SCCS-cys-gly
+4 0 *********** CCCS-pro-thr
+ 1 -9.07849E-01 7.76719E-02
+ 2 -4.72132E-01 8.11280E-02
+ 3 1.26137E-01 -1.61329E-01
+ 4 3.84860E-02 2.42118E-02
+4 0 *********** CCCS-pro-ser
+ 1 -1.61551E+00 -8.47812E-01
+ 2 3.57056E-02 -4.29341E-01
+ 3 -3.91253E-03 1.22740E-01
+ 4 -8.20854E-02 3.68427E-03
+4 0 *********** CCCS-pro-gln
+ 1 -9.33947E-01 6.75567E-04
+ 2 -2.41565E-01 -7.64516E-02
+ 3 -1.67072E-02 -6.96706E-02
+ 4 4.83193E-02 5.10288E-02
+4 0 *********** CCCS-pro-asn
+ 1 -1.18314E+00 -4.98674E-01
+ 2 7.15421E-02 -3.86403E-01
+ 3 -9.88056E-03 6.35419E-02
+ 4 -5.85735E-03 1.90402E-02
+4 0 *********** CCCS-pro-glu
+ 1 -1.04480E+00 5.79008E-02
+ 2 -2.91891E-01 3.08634E-02
+ 3 -5.16516E-03 -1.28810E-01
+ 4 5.90039E-02 3.42053E-02
+4 0 *********** CCCS-pro-asp
+ 1 -1.35548E+00 -6.24364E-01
+ 2 1.14171E-02 -3.92476E-01
+ 3 2.95114E-02 1.43079E-01
+ 4 -1.17147E-02 -1.66194E-02
+4 0 *********** CCCS-pro-his
+ 1 -1.20336E+00 -4.62056E-01
+ 2 1.70184E-01 -2.39155E-01
+ 3 6.15741E-02 -8.19429E-02
+ 4 -5.70485E-02 1.15489E-02
+4 0 *********** CCCS-pro-arg
+ 1 -6.89422E-01 2.07042E-01
+ 2 -1.98428E-01 3.20765E-01
+ 3 -2.68026E-02 -1.28322E-01
+ 4 -7.48013E-03 4.31463E-03
+4 0 *********** CCCS-pro-lys
+ 1 -5.65205E-01 2.73646E-01
+ 2 -3.36290E-01 3.45283E-01
+ 3 4.67419E-02 -1.36545E-01
+ 4 6.86319E-03 -1.94038E-02
+4 0 *********** CCCS-pro-pro
+ 1 -3.30913E+00 -7.17640E-01
+ 2 4.70082E-01 -4.72589E-02
+ 3 -3.03019E-01 -1.08208E-01
+ 4 1.72759E-01 1.84493E-01
+4 0 *********** SCCS-cys-cys
+ 1 8.67192E-01 -3.97420E-01
+ 2 -1.42331E-01 1.54790E-01
+ 3 1.17768E-01 -6.88353E-02
+ 4 1.16808E-02 -4.88455E-02
+4 0 *********** SCCS-cys-met
+ 1 4.26597E-01 -4.96269E-01
+ 2 1.68255E-01 2.05715E-01
+ 3 6.45820E-02 -5.78164E-02
+ 4 -3.30813E-02 -2.01771E-02
+4 0 *********** SCCS-cys-phe
+ 1 4.30309E-01 -5.81996E-01
+ 2 2.91210E-01 3.75351E-02
+ 3 -2.51574E-02 -4.52847E-02
+ 4 -4.59956E-02 2.64473E-02
+4 0 *********** SCCS-cys-ile
+ 1 5.92263E-01 -5.56017E-01
+ 2 1.96396E-01 2.73218E-01
+ 3 7.20998E-02 -8.12583E-02
+ 4 -9.05831E-03 -5.08715E-02
+4 0 *********** SCCS-cys-leu
+ 1 2.23589E-01 -5.45461E-01
+ 2 4.10204E-01 2.68121E-01
+ 3 5.34177E-02 -5.72668E-02
+ 4 -4.98470E-02 1.26762E-02
+4 0 *********** SCCS-cys-val
+ 1 4.91308E-01 -5.42737E-01
+ 2 2.59371E-01 3.06256E-01
+ 3 6.44313E-02 -7.06936E-02
+ 4 -3.66479E-02 -3.46126E-02
+4 0 *********** SCCS-cys-trp
+ 1 4.71912E-01 -6.01415E-01
+ 2 2.16418E-01 8.00790E-02
+ 3 -1.30446E-02 -5.24377E-02
+ 4 -4.99798E-02 3.07055E-03
+4 0 *********** SCCS-cys-tyr
+ 1 4.16234E-01 -5.77036E-01
+ 2 2.74265E-01 2.25244E-02
+ 3 -2.83527E-02 -4.49149E-02
+ 4 -4.88884E-02 2.31939E-02
+4 0 *********** SCCS-cys-ala
+ 1 3.34091E-01 -3.42304E-01
+ 2 8.50400E-03 5.26987E-01
+ 3 9.62156E-02 2.68970E-02
+ 4 2.14985E-02 -4.83972E-02
+4 0 *********** SCCS-cys-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-cys-thr
- 1 -5.46356E-01 -8.38215E-03
- 2 3.03493E-01 -8.73490E-02
- 3 -1.13922E-01 -4.59477E-02
- 4 -4.61134E-02 2.05623E-02
- 5 -2.94384E-02 -1.83005E-02
- 6 -3.54389E-02 -2.50395E-02
-6 0 *********** SCCS-cys-ser
- 1 -1.08249E+00 -2.83620E-01
- 2 6.95394E-01 3.27434E-01
- 3 -7.45357E-02 -1.11475E-01
- 4 -1.53819E-02 1.40160E-01
- 5 5.63049E-02 -4.18293E-02
- 6 -6.10263E-02 -3.46170E-01
-6 0 *********** SCCS-cys-gln
- 1 -5.65683E-01 -7.10455E-02
- 2 2.78181E-01 1.96852E-02
- 3 -5.38471E-02 -7.97023E-02
- 4 -1.26169E-02 4.81418E-02
- 5 -3.89308E-02 -3.32238E-02
- 6 -2.65113E-02 -1.18029E-01
-6 0 *********** SCCS-cys-asn
- 1 -5.92254E-01 -4.39328E-01
- 2 2.07485E-01 5.05557E-01
- 3 -2.87719E-01 1.43563E-03
- 4 -4.98893E-03 6.43461E-02
- 5 -1.53681E-01 -7.23762E-03
- 6 1.92644E-03 -2.97587E-01
-6 0 *********** SCCS-cys-glu
- 1 -6.05273E-01 -7.85402E-03
- 2 3.00492E-01 -7.43861E-02
- 3 -3.57721E-02 -7.93173E-02
- 4 -2.53242E-02 4.32863E-02
- 5 -4.30476E-02 -4.32000E-02
- 6 -2.45313E-02 -8.18778E-02
-6 0 *********** SCCS-cys-asp
- 1 -6.26683E-01 -4.16653E-01
- 2 3.27329E-01 4.96692E-01
- 3 -2.45528E-01 1.29877E-02
- 4 -4.66358E-02 2.27608E-01
- 5 -1.05259E-01 -5.78596E-03
- 6 -8.03820E-02 -3.93242E-01
-6 0 *********** SCCS-cys-his
- 1 -5.06525E-01 -4.01016E-01
- 2 1.29621E-01 4.30216E-01
- 3 -2.29501E-01 3.28900E-03
- 4 -5.83972E-02 6.74478E-02
- 5 -9.96947E-02 -2.87512E-02
- 6 -3.50809E-02 -2.79903E-01
-6 0 *********** SCCS-cys-arg
- 1 -4.14680E-01 8.32294E-02
- 2 8.56744E-02 -1.59767E-01
- 3 -8.35930E-02 -1.36921E-01
- 4 -4.67937E-02 4.28600E-02
- 5 -9.73125E-02 -4.90759E-02
- 6 -2.17442E-02 -7.50254E-02
-6 0 *********** SCCS-cys-lys
- 1 -4.27105E-01 8.52206E-02
- 2 1.02759E-01 -2.06069E-01
- 3 -3.22450E-02 -1.25608E-01
- 4 -4.00735E-02 5.98395E-02
- 5 -1.03990E-01 -7.29824E-02
- 6 -1.34882E-02 -8.35192E-02
-6 0 *********** SCCS-cys-pro
- 1 4.94639E-01 8.68176E-01
- 2 -7.16665E-03 1.60535E+00
- 3 -8.74111E-01 9.04209E-01
- 4 1.54482E-01 3.53449E-01
- 5 -1.13140E+00 2.97469E-01
- 6 -9.00044E-02 6.74301E-02
-6 0 *********** SCCS-met-cys
- 1 -4.40648E-01 -8.23157E-01
- 2 3.57550E-01 2.17083E-02
- 3 -1.16876E-01 -3.07260E-02
- 4 7.79965E-02 -3.34766E-03
- 5 -9.44428E-02 -1.35223E-02
- 6 1.72642E-02 -1.79171E-01
-6 0 *********** SCCS-met-met
- 1 -3.84052E-01 -5.00461E-01
- 2 1.00422E-01 -2.82195E-01
- 3 -1.35104E-01 -1.01063E-01
- 4 -6.73487E-02 2.86005E-02
- 5 -7.07540E-02 -5.40435E-02
- 6 -4.53469E-02 -1.06904E-01
-6 0 *********** SCCS-met-phe
- 1 -4.06116E-01 -5.17834E-01
- 2 -8.47552E-02 -2.48583E-01
- 3 -1.22849E-01 -2.60508E-01
- 4 -1.60273E-01 1.07448E-01
- 5 1.25019E-02 -9.99241E-02
- 6 -1.13720E-01 -2.93365E-01
-6 0 *********** SCCS-met-ile
- 1 -3.76689E-01 -5.96643E-01
- 2 1.47021E-01 -2.59806E-01
- 3 -1.98193E-01 -1.24639E-01
- 4 -1.02936E-01 2.18792E-02
- 5 -6.21120E-02 -5.03216E-02
- 6 -7.49733E-02 -1.35329E-01
-6 0 *********** SCCS-met-leu
- 1 -4.15837E-01 -4.06127E-01
- 2 3.15224E-02 -5.31861E-01
- 3 -1.98245E-01 -1.24374E-01
- 4 -2.91813E-02 4.20351E-02
- 5 -2.27827E-01 -6.47354E-02
- 6 3.44053E-02 -4.38596E-02
-6 0 *********** SCCS-met-val
- 1 -4.40391E-01 -4.93969E-01
- 2 8.73701E-02 -3.48664E-01
- 3 -1.20920E-01 -1.98210E-01
- 4 -1.98372E-01 9.33014E-02
- 5 -8.60502E-03 -1.06582E-01
- 6 -9.57452E-02 -2.21304E-01
-6 0 *********** SCCS-met-trp
- 1 -3.88577E-01 -5.54384E-01
- 2 3.92167E-02 -2.02794E-01
- 3 -1.38330E-01 -1.14018E-01
- 4 -4.55223E-02 1.62095E-02
- 5 -1.18694E-01 -4.75900E-02
- 6 -2.66408E-02 -1.40127E-01
-6 0 *********** SCCS-met-tyr
- 1 -4.11894E-01 -5.19276E-01
- 2 -1.03740E-01 -2.04605E-01
- 3 -1.29785E-01 -2.61280E-01
- 4 -1.73822E-01 1.24499E-01
- 5 2.00019E-02 -1.09933E-01
- 6 -1.22511E-01 -3.28760E-01
-6 0 *********** SCCS-met-ala
- 1 -3.44888E-01 -4.08453E-01
- 2 4.89948E-01 -3.68112E-01
- 3 -2.63780E-01 1.74467E-02
- 4 8.99364E-02 -2.11717E-02
- 5 -2.84007E-01 -2.48871E-02
- 6 5.45323E-02 5.73032E-02
-6 0 *********** SCCS-met-gly
+4 0 *********** SCCS-cys-thr
+ 1 5.34364E-01 -5.20718E-01
+ 2 3.54739E-02 3.67105E-01
+ 3 7.05045E-02 -2.83985E-02
+ 4 3.20212E-02 -5.62046E-02
+4 0 *********** SCCS-cys-ser
+ 1 1.08515E+00 -2.62182E-01
+ 2 -3.11425E-01 1.33473E-01
+ 3 9.24029E-02 -1.02550E-01
+ 4 1.03816E-01 -6.31816E-02
+4 0 *********** SCCS-cys-gln
+ 1 5.66258E-01 -5.39383E-01
+ 2 -2.13376E-02 2.06540E-01
+ 3 -3.79359E-02 -7.98189E-02
+ 4 -4.15080E-02 -4.31848E-02
+4 0 *********** SCCS-cys-asn
+ 1 9.22612E-01 -2.63118E-01
+ 2 -2.41432E-01 6.53561E-02
+ 3 2.40540E-02 -3.36319E-02
+ 4 2.68269E-02 9.52648E-03
+4 0 *********** SCCS-cys-glu
+ 1 5.96137E-01 -6.10543E-01
+ 2 3.53487E-02 2.27789E-01
+ 3 -1.67001E-02 -8.81237E-02
+ 4 -4.14545E-02 -3.65214E-02
+4 0 *********** SCCS-cys-asp
+ 1 1.01795E+00 -2.60910E-01
+ 2 -1.97330E-01 1.05405E-01
+ 3 4.50490E-02 -4.55831E-03
+ 4 2.89560E-02 2.39952E-02
+4 0 *********** SCCS-cys-his
+ 1 8.90355E-01 -2.91398E-01
+ 2 -1.50779E-01 3.51671E-03
+ 3 1.32057E-01 -3.87007E-02
+ 4 7.11463E-02 3.32134E-02
+4 0 *********** SCCS-cys-arg
+ 1 3.05165E-01 -5.50396E-01
+ 2 2.65996E-01 1.34162E-01
+ 3 1.63970E-02 -6.55688E-02
+ 4 -1.63990E-02 -6.42449E-03
+4 0 *********** SCCS-cys-lys
+ 1 2.10559E-01 -5.08694E-01
+ 2 2.92920E-01 2.11781E-01
+ 3 7.45051E-02 -4.33034E-02
+ 4 -2.31646E-02 5.82520E-03
+4 0 *********** SCCS-cys-pro
+ 1 1.19886E+00 -1.94173E-01
+ 2 -2.59796E-01 1.46925E-01
+ 3 2.03461E-01 -1.47537E-01
+ 4 1.86013E-01 1.95403E-02
+4 0 *********** SCCS-met-cys
+ 1 6.77842E-01 -1.22147E-01
+ 2 3.01442E-02 -8.28383E-02
+ 3 2.53218E-02 -2.89579E-02
+ 4 2.32855E-02 -1.30591E-02
+4 0 *********** SCCS-met-met
+ 1 3.93839E-01 -2.65359E-01
+ 2 -2.98951E-02 -7.82974E-04
+ 3 -6.71525E-03 2.70051E-03
+ 4 -4.19784E-03 -6.76316E-03
+4 0 *********** SCCS-met-phe
+ 1 3.47890E-01 -3.31177E-01
+ 2 -1.40210E-02 1.34047E-02
+ 3 -6.20698E-03 9.61245E-03
+ 4 -7.78514E-03 2.24073E-03
+4 0 *********** SCCS-met-ile
+ 1 5.15140E-01 -2.68442E-01
+ 2 -3.13116E-02 -3.35772E-02
+ 3 -1.11768E-02 -9.13918E-03
+ 4 6.51943E-03 -1.56479E-02
+4 0 *********** SCCS-met-leu
+ 1 2.97078E-01 -3.52096E-01
+ 2 -4.44542E-02 4.92139E-02
+ 3 1.62294E-03 8.51857E-03
+ 4 -1.90766E-02 -1.67157E-03
+4 0 *********** SCCS-met-val
+ 1 4.44647E-01 -3.10886E-01
+ 2 -5.17011E-02 -3.76384E-03
+ 3 -2.22666E-02 5.59111E-04
+ 4 -1.13944E-02 -1.24191E-02
+4 0 *********** SCCS-met-trp
+ 1 4.26445E-01 -3.01683E-01
+ 2 -1.23552E-02 -1.83657E-02
+ 3 -1.26295E-02 -8.84208E-03
+ 4 -4.38497E-03 -6.94827E-03
+4 0 *********** SCCS-met-tyr
+ 1 3.35211E-01 -3.27458E-01
+ 2 -8.79237E-03 1.12200E-02
+ 3 -5.55911E-03 9.19752E-03
+ 4 -8.69196E-03 2.27149E-03
+4 0 *********** SCCS-met-ala
+ 1 3.47583E-01 -1.40409E-01
+ 2 -7.66753E-02 2.14822E-02
+ 3 -1.83836E-03 1.15904E-02
+ 4 7.81264E-03 -1.16514E-02
+4 0 *********** SCCS-met-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-met-thr
- 1 -3.28921E-01 -5.15095E-01
- 2 3.02493E-01 -2.95297E-01
- 3 -1.96756E-01 -1.85399E-01
- 4 -5.69217E-02 -6.18868E-02
- 5 -8.22300E-02 -6.33454E-02
- 6 -5.41360E-02 -9.55429E-02
-6 0 *********** SCCS-met-ser
- 1 -8.09969E-01 -1.05312E+00
- 2 6.15521E-01 2.76109E-01
- 3 -2.35733E-02 -2.13770E-01
- 4 4.13078E-02 8.23782E-02
- 5 3.80815E-02 -6.09184E-02
- 6 -2.38641E-02 -4.84823E-01
-6 0 *********** SCCS-met-gln
- 1 -4.46380E-01 -6.08000E-01
- 2 2.46235E-01 -1.08523E-01
- 3 -1.06118E-01 -1.18742E-01
- 4 -3.01210E-02 5.15472E-03
- 5 -6.29406E-02 -2.41803E-02
- 6 -3.16821E-02 -1.53858E-01
-6 0 *********** SCCS-met-asn
- 1 -1.64359E-01 -8.16222E-01
- 2 3.04739E-01 3.79406E-01
- 3 -2.19302E-01 -2.04363E-02
- 4 1.28449E-01 2.00877E-02
- 5 -1.63667E-01 -2.19955E-02
- 6 5.76872E-02 -3.07047E-01
-6 0 *********** SCCS-met-glu
- 1 -5.17605E-01 -6.19269E-01
- 2 2.62896E-01 -2.00396E-01
- 3 -1.34743E-01 -1.44076E-01
- 4 -7.10931E-02 -1.47989E-02
- 5 -7.87967E-02 -1.72038E-02
- 6 -3.32032E-02 -1.16833E-01
-6 0 *********** SCCS-met-asp
- 1 -6.66296E-02 -6.86112E-01
- 2 5.20732E-01 3.34009E-01
- 3 -1.07526E-01 -9.95903E-02
- 4 -2.40285E-02 1.73802E-01
- 5 -2.58508E-02 3.07996E-02
- 6 -1.92849E-02 -3.65318E-01
-6 0 *********** SCCS-met-his
- 1 -1.42119E-01 -9.00856E-01
- 2 1.26164E-01 3.57382E-01
- 3 -1.04021E-01 -3.53492E-02
- 4 4.59235E-03 5.78228E-03
- 5 -5.40533E-02 -5.38778E-02
- 6 -7.20234E-03 -3.37805E-01
-6 0 *********** SCCS-met-arg
- 1 -4.22845E-01 -3.95052E-01
- 2 1.20234E-03 -2.85629E-01
- 3 -1.56866E-01 -1.12423E-01
- 4 -7.67059E-02 3.65577E-02
- 5 -8.52288E-02 -6.47195E-02
- 6 -2.38007E-02 -1.08320E-01
-6 0 *********** SCCS-met-lys
- 1 -3.73678E-01 -4.04217E-01
- 2 3.05616E-02 -3.87928E-01
- 3 -1.72906E-01 -9.61810E-02
- 4 -6.25771E-02 4.14123E-02
- 5 -1.44767E-01 -5.24466E-02
- 6 -6.89935E-03 -6.03887E-02
-6 0 *********** SCCS-met-pro
- 1 -7.94019E-01 4.73402E-01
- 2 -4.35125E-01 2.09023E+00
- 3 -5.15019E-01 4.09889E-01
- 4 -1.09590E-01 -3.32620E-01
- 5 -8.07757E-01 4.82847E-01
- 6 1.06730E-01 2.17904E-01
-6 0 *********** SCCS-phe-cys
- 1 -4.77720E-01 -1.19189E+00
- 2 3.11049E-01 -1.32231E-01
- 3 -1.62767E-01 -1.17713E-01
- 4 -9.10289E-02 1.10568E-01
- 5 7.25370E-02 -1.11469E-01
- 6 -1.25959E-01 -3.76241E-01
-6 0 *********** SCCS-phe-met
- 1 -4.22573E-01 -6.83855E-01
- 2 -5.47756E-02 -2.97389E-01
- 3 -1.71183E-01 -7.05160E-02
- 4 -7.23906E-02 6.75718E-02
- 5 -4.80395E-02 -6.30420E-02
- 6 -5.52961E-02 -1.50666E-01
-6 0 *********** SCCS-phe-phe
- 1 -4.74883E-01 -7.56680E-01
- 2 -2.47371E-01 -2.61330E-01
- 3 -1.41954E-01 -7.87211E-02
- 4 7.56003E-03 5.40319E-02
- 5 -1.27301E-01 -7.02696E-02
- 6 -5.45888E-02 -1.77698E-01
-6 0 *********** SCCS-phe-ile
- 1 -4.72150E-01 -8.60317E-01
- 2 -1.16033E-01 -3.55364E-01
- 3 -2.43430E-01 -5.53555E-02
- 4 -1.49856E-01 1.38837E-01
- 5 3.21433E-02 -4.26979E-02
- 6 -7.49414E-02 -1.86628E-01
-6 0 *********** SCCS-phe-leu
- 1 -4.13339E-01 -5.63590E-01
- 2 -3.13046E-01 -5.65163E-01
- 3 -1.49460E-01 -5.38196E-02
- 4 -7.52139E-02 1.23860E-01
- 5 -1.11313E-01 -7.94510E-02
- 6 -1.98189E-02 -8.39389E-02
-6 0 *********** SCCS-phe-val
- 1 -4.84643E-01 -7.05534E-01
- 2 -2.40577E-02 -5.07636E-01
- 3 -3.95941E-01 -5.36785E-03
- 4 -4.30410E-03 5.48310E-02
- 5 -2.01757E-01 9.60730E-03
- 6 3.83940E-02 8.12650E-03
-6 0 *********** SCCS-phe-trp
- 1 -5.23208E-01 -7.69790E-01
- 2 -1.65588E-01 -1.60544E-01
- 3 -1.27467E-01 -9.48473E-02
- 4 -4.74938E-02 4.74844E-02
- 5 -8.51877E-02 -7.00972E-02
- 6 -5.28242E-02 -2.15356E-01
-6 0 *********** SCCS-phe-tyr
- 1 -4.73067E-01 -7.53833E-01
- 2 -2.37343E-01 -2.20817E-01
- 3 -1.40242E-01 -1.20171E-01
- 4 -4.79766E-02 6.35251E-02
- 5 -7.93764E-02 -7.81519E-02
- 6 -6.02793E-02 -2.24916E-01
-6 0 *********** SCCS-phe-ala
- 1 -1.16121E-01 -6.23136E-01
- 2 1.71710E-01 -5.45137E-01
- 3 -2.45494E-01 -4.47752E-02
- 4 -1.14405E-01 4.81874E-02
- 5 -2.21757E-02 -4.14914E-03
- 6 -4.54070E-02 1.41510E-02
-6 0 *********** SCCS-phe-gly
+4 0 *********** SCCS-met-thr
+ 1 5.08255E-01 -2.52922E-01
+ 2 -4.50710E-02 -2.69872E-02
+ 3 -1.48451E-02 -1.40399E-02
+ 4 4.39034E-03 -1.89867E-02
+4 0 *********** SCCS-met-ser
+ 1 8.01001E-01 -4.95313E-02
+ 2 9.72315E-02 -9.47434E-02
+ 3 6.93740E-02 -4.24953E-02
+ 4 5.18705E-02 -1.18763E-02
+4 0 *********** SCCS-met-gln
+ 1 5.01149E-01 -2.69021E-01
+ 2 -2.49395E-02 -4.99726E-02
+ 3 -1.56056E-02 -2.12705E-02
+ 4 -7.22647E-03 -1.64211E-02
+4 0 *********** SCCS-met-asn
+ 1 6.73569E-01 1.52099E-02
+ 2 7.13503E-02 -6.74262E-02
+ 3 3.90477E-02 -1.39945E-02
+ 4 2.52162E-02 3.59290E-03
+4 0 *********** SCCS-met-glu
+ 1 5.25931E-01 -3.25302E-01
+ 2 -3.29368E-02 -5.37539E-02
+ 3 -1.90438E-02 -2.32002E-02
+ 4 -9.20583E-03 -1.93397E-02
+4 0 *********** SCCS-met-asp
+ 1 7.14424E-01 1.99294E-02
+ 2 9.11002E-02 -6.60162E-02
+ 3 4.52199E-02 -1.28745E-02
+ 4 3.06190E-02 5.71878E-03
+4 0 *********** SCCS-met-his
+ 1 6.48672E-01 3.96519E-02
+ 2 9.07352E-02 -5.93949E-02
+ 3 3.52519E-02 1.88478E-03
+ 4 2.44209E-02 1.78793E-02
+4 0 *********** SCCS-met-arg
+ 1 3.07539E-01 -3.33991E-01
+ 2 -2.38728E-02 1.77764E-02
+ 3 -2.32994E-03 6.48369E-03
+ 4 -6.48227E-03 -1.82843E-03
+4 0 *********** SCCS-met-lys
+ 1 2.74243E-01 -3.17318E-01
+ 2 -3.79758E-02 3.83663E-02
+ 3 3.07022E-03 1.29550E-02
+ 4 -1.17798E-02 -9.80492E-04
+4 0 *********** SCCS-met-pro
+ 1 8.53443E-01 6.32717E-04
+ 2 1.54723E-01 -9.89519E-02
+ 3 1.33621E-01 -3.85601E-02
+ 4 1.13225E-01 2.03647E-02
+4 0 *********** SCCS-phe-cys
+ 1 6.17912E-01 4.08053E-02
+ 2 8.03708E-02 -1.78292E-01
+ 3 -4.69639E-02 -4.27914E-02
+ 4 -1.76101E-02 4.81626E-02
+4 0 *********** SCCS-phe-met
+ 1 4.00919E-01 -1.33434E-01
+ 2 -8.47991E-02 -1.11941E-01
+ 3 -6.60895E-02 3.54194E-02
+ 4 -2.32957E-02 -4.88659E-03
+4 0 *********** SCCS-phe-phe
+ 1 3.70355E-01 -2.13805E-01
+ 2 -1.33203E-01 -6.44535E-02
+ 3 -2.38403E-02 5.51917E-02
+ 4 -4.77525E-02 3.66054E-02
+4 0 *********** SCCS-phe-ile
+ 1 4.83527E-01 -1.13031E-01
+ 2 -5.50937E-02 -1.64700E-01
+ 3 -1.21456E-01 4.46557E-03
+ 4 -4.47308E-03 -2.79464E-02
+4 0 *********** SCCS-phe-leu
+ 1 3.30503E-01 -2.51950E-01
+ 2 -1.85358E-01 -7.54903E-02
+ 3 -8.18024E-03 9.43208E-02
+ 4 -4.27669E-02 -1.78173E-02
+4 0 *********** SCCS-phe-val
+ 1 4.61384E-01 -1.89805E-01
+ 2 -1.19066E-01 -1.67802E-01
+ 3 -9.11416E-02 5.00339E-02
+ 4 -2.91337E-02 -4.54035E-02
+4 0 *********** SCCS-phe-trp
+ 1 4.21300E-01 -1.36878E-01
+ 2 -6.85968E-02 -7.57692E-02
+ 3 -7.08461E-02 5.92965E-02
+ 4 -2.27440E-02 -1.34410E-03
+4 0 *********** SCCS-phe-tyr
+ 1 3.56633E-01 -2.11338E-01
+ 2 -1.21404E-01 -4.96290E-02
+ 3 -2.81706E-02 4.66030E-02
+ 4 -3.18445E-02 3.78772E-02
+4 0 *********** SCCS-phe-ala
+ 1 3.36910E-01 -6.87199E-02
+ 2 -8.07815E-02 -1.92038E-01
+ 3 -1.00267E-01 3.43753E-02
+ 4 5.43754E-02 -3.09258E-02
+4 0 *********** SCCS-phe-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-phe-thr
- 1 -3.97080E-01 -6.86184E-01
- 2 1.81891E-01 -5.52630E-01
- 3 -3.83171E-01 -1.08834E-01
- 4 -6.45258E-03 -5.66500E-02
- 5 -2.73262E-01 -1.94285E-02
- 6 1.35721E-02 3.65688E-02
-6 0 *********** SCCS-phe-ser
- 1 -6.23725E-01 -1.58496E+00
- 2 6.98394E-01 -1.07993E-01
- 3 -1.95352E-01 -9.47647E-02
- 4 1.90337E-02 -2.63999E-02
- 5 -1.09746E-01 -9.80081E-02
- 6 3.15061E-02 -3.43566E-01
-6 0 *********** SCCS-phe-gln
- 1 -4.98920E-01 -8.30863E-01
- 2 6.35253E-02 -1.61680E-01
- 3 -8.81663E-02 -1.20723E-01
- 4 -1.26542E-02 1.38600E-02
- 5 -2.27741E-02 -9.09493E-02
- 6 -5.06644E-02 -2.34981E-01
-6 0 *********** SCCS-phe-asn
- 1 4.97500E-02 -1.09296E+00
- 2 2.36387E-01 2.72975E-01
- 3 -2.96556E-02 -1.56050E-01
- 4 -4.47871E-02 3.28199E-02
- 5 -3.03638E-02 -6.34265E-02
- 6 -5.35005E-02 -4.25285E-01
-6 0 *********** SCCS-phe-glu
- 1 -5.96593E-01 -8.89185E-01
- 2 2.08404E-02 -2.69112E-01
- 3 -1.15377E-01 -1.13473E-01
- 4 -4.24806E-02 1.99648E-02
- 5 -2.88386E-02 -8.00633E-02
- 6 -5.70793E-02 -2.07468E-01
-6 0 *********** SCCS-phe-asp
- 1 1.85776E-01 -9.15278E-01
- 2 5.52340E-01 1.33137E-01
- 3 -4.57073E-02 -2.46623E-01
- 4 -2.56981E-02 1.00929E-01
- 5 6.63062E-02 -8.89455E-02
- 6 -7.99884E-02 -4.58913E-01
-6 0 *********** SCCS-phe-his
- 1 -7.96019E-02 -1.31776E+00
- 2 5.05884E-02 1.85026E-01
- 3 -1.38229E-01 -4.13929E-02
- 4 -3.28063E-02 3.43186E-02
- 5 -9.41024E-02 -5.25009E-02
- 6 -5.40753E-02 -3.73950E-01
-6 0 *********** SCCS-phe-arg
- 1 -4.74505E-01 -5.40996E-01
- 2 -1.39061E-01 -2.91173E-01
- 3 -1.99127E-01 -4.48236E-02
- 4 1.33532E-02 3.44437E-02
- 5 -1.42821E-01 -4.41293E-02
- 6 -1.80308E-02 -8.02370E-02
-6 0 *********** SCCS-phe-lys
- 1 -4.21541E-01 -5.20319E-01
- 2 -1.63285E-01 -3.82184E-01
- 3 -1.58106E-01 -9.39399E-02
- 4 -1.08373E-01 1.26981E-01
- 5 -2.23846E-02 -7.85287E-02
- 6 -5.73183E-02 -1.56062E-01
-6 0 *********** SCCS-phe-pro
- 1 -2.15318E+00 -2.86309E-02
- 2 -3.82770E-01 3.15290E+00
- 3 4.87991E-01 3.49936E-01
- 4 -7.52288E-01 -2.73225E-01
- 5 -6.95114E-01 4.22811E-01
- 6 2.04513E-02 -3.22089E-01
-6 0 *********** SCCS-ile-cys
- 1 -3.66362E-01 -4.37426E-01
- 2 5.37390E-01 2.32705E-02
- 3 -1.02074E-01 -9.60693E-02
- 4 5.71536E-02 -1.07946E-02
- 5 -5.55116E-02 -2.29703E-02
- 6 -3.24376E-03 -1.40591E-01
-6 0 *********** SCCS-ile-met
- 1 -3.39501E-01 -2.68760E-01
- 2 1.01068E-01 -2.90853E-01
- 3 -1.24444E-01 -1.24910E-01
- 4 -5.88246E-02 2.94906E-02
- 5 -1.04711E-01 -5.10055E-02
- 6 -2.92503E-02 -7.37541E-02
-6 0 *********** SCCS-ile-phe
- 1 -3.21982E-01 -2.59359E-01
- 2 -1.05171E-01 -3.01575E-01
- 3 -1.76793E-01 -1.60188E-01
- 4 -3.55047E-02 5.60801E-02
- 5 -1.23136E-01 -3.46645E-02
- 6 -2.66364E-02 -9.10756E-02
-6 0 *********** SCCS-ile-ile
- 1 -3.81223E-01 -3.03959E-01
- 2 1.29061E-01 -2.93015E-01
- 3 -1.17933E-01 -8.36166E-02
- 4 -7.92858E-02 2.23016E-02
- 5 -1.33755E-01 -5.44812E-02
- 6 -3.00558E-02 -6.06688E-02
-6 0 *********** SCCS-ile-leu
- 1 -3.71001E-01 -9.55315E-02
- 2 -2.04756E-01 -4.16649E-01
- 3 -6.86485E-02 -2.98134E-01
- 4 -1.73242E-01 1.66972E-01
- 5 -9.39167E-03 -8.75446E-02
- 6 -9.43430E-02 -2.09801E-01
-6 0 *********** SCCS-ile-val
- 1 -3.54833E-01 -2.39039E-01
- 2 4.45292E-02 -4.47911E-01
- 3 -1.30083E-01 -1.30964E-01
- 4 -3.10455E-02 5.29424E-02
- 5 -2.01350E-01 -2.40452E-02
- 6 6.12922E-03 -1.53781E-02
-6 0 *********** SCCS-ile-trp
- 1 -3.65137E-01 -3.14193E-01
- 2 9.27431E-02 -2.27563E-01
- 3 -1.27390E-01 -1.08860E-01
- 4 -5.24822E-02 3.74832E-02
- 5 -9.38747E-02 -4.82880E-02
- 6 -2.91066E-02 -1.00919E-01
-6 0 *********** SCCS-ile-tyr
- 1 -3.29671E-01 -2.61676E-01
- 2 -1.08412E-01 -2.83339E-01
- 3 -1.97386E-01 -1.50580E-01
- 4 2.71883E-03 5.42508E-02
- 5 -1.39960E-01 -2.37462E-02
- 6 -2.27496E-02 -8.50223E-02
-6 0 *********** SCCS-ile-ala
- 1 -4.78099E-01 -2.24743E-01
- 2 2.44743E-01 -2.07951E-01
- 3 2.35548E-02 -2.81703E-01
- 4 -2.51433E-01 1.48554E-01
- 5 1.38615E-01 -1.28752E-01
- 6 -1.44817E-01 -3.15873E-01
-6 0 *********** SCCS-ile-gly
+4 0 *********** SCCS-phe-thr
+ 1 4.82970E-01 -9.10727E-02
+ 2 -5.58281E-02 -1.57682E-01
+ 3 -1.33460E-01 -6.99795E-03
+ 4 2.48573E-02 -7.19938E-02
+4 0 *********** SCCS-phe-ser
+ 1 7.61323E-01 9.17861E-02
+ 2 2.06520E-01 -1.99787E-01
+ 3 4.29281E-02 -8.32855E-02
+ 4 1.72165E-02 4.10619E-02
+4 0 *********** SCCS-phe-gln
+ 1 4.86846E-01 -1.05888E-01
+ 2 -3.94640E-02 -1.43621E-01
+ 3 -1.07811E-01 2.13469E-02
+ 4 -4.22265E-03 -2.88818E-02
+4 0 *********** SCCS-phe-asn
+ 1 6.17192E-01 1.32884E-01
+ 2 2.11050E-01 -1.43871E-01
+ 3 -3.77821E-02 -7.12819E-02
+ 4 2.23335E-02 5.71418E-02
+4 0 *********** SCCS-phe-glu
+ 1 5.12548E-01 -1.55228E-01
+ 2 -7.80945E-02 -1.54708E-01
+ 3 -1.17487E-01 3.69667E-02
+ 4 4.81689E-03 -2.57806E-02
+4 0 *********** SCCS-phe-asp
+ 1 6.54725E-01 1.36981E-01
+ 2 2.27435E-01 -1.56591E-01
+ 3 -1.76645E-02 -8.60832E-02
+ 4 2.41417E-02 4.79527E-02
+4 0 *********** SCCS-phe-his
+ 1 5.71382E-01 1.65067E-01
+ 2 2.21862E-01 -1.03689E-01
+ 3 7.14090E-03 -1.05914E-01
+ 4 1.86059E-02 4.81888E-02
+4 0 *********** SCCS-phe-arg
+ 1 3.46205E-01 -2.19591E-01
+ 2 -1.23250E-01 -6.09198E-02
+ 3 -3.07295E-02 6.26693E-02
+ 4 -2.18389E-02 -3.92536E-04
+4 0 *********** SCCS-phe-lys
+ 1 3.12189E-01 -2.08352E-01
+ 2 -1.38776E-01 -7.42432E-02
+ 3 -2.46965E-02 6.30946E-02
+ 4 -2.00432E-02 -2.35017E-03
+4 0 *********** SCCS-phe-pro
+ 1 5.75671E-01 1.88566E-01
+ 2 1.73271E-01 -2.03893E-01
+ 3 -4.52139E-02 -2.19582E-01
+ 4 1.30494E-01 1.14331E-01
+4 0 *********** SCCS-ile-cys
+ 1 8.12861E-01 -3.96504E-03
+ 2 -4.19983E-02 -1.84176E-01
+ 3 2.24503E-02 -1.66688E-01
+ 4 1.95631E-02 -1.59739E-02
+4 0 *********** SCCS-ile-met
+ 1 5.06126E-01 -1.90924E-01
+ 2 -1.04465E-01 5.08062E-02
+ 3 -4.34139E-02 -8.62438E-03
+ 4 2.80063E-03 -1.68203E-02
+4 0 *********** SCCS-ile-phe
+ 1 4.61933E-01 -2.73111E-01
+ 2 -4.71593E-02 1.06871E-01
+ 3 -4.16029E-02 3.21457E-02
+ 4 -2.32600E-02 -2.22548E-02
+4 0 *********** SCCS-ile-ile
+ 1 6.43631E-01 -1.58904E-01
+ 2 -1.37423E-01 -2.45357E-02
+ 3 -4.92316E-02 -4.74913E-02
+ 4 8.06138E-03 -1.35900E-02
+4 0 *********** SCCS-ile-leu
+ 1 4.08520E-01 -3.13005E-01
+ 2 -1.27566E-01 1.49512E-01
+ 3 -6.34900E-02 3.46685E-02
+ 4 -9.06413E-03 -3.52161E-02
+4 0 *********** SCCS-ile-val
+ 1 5.49852E-01 -2.38227E-01
+ 2 -1.86617E-01 6.55581E-02
+ 3 -8.85027E-02 -2.08951E-03
+ 4 2.05440E-02 -1.84654E-02
+4 0 *********** SCCS-ile-trp
+ 1 5.56619E-01 -2.29250E-01
+ 2 -7.23091E-02 2.04708E-02
+ 3 -5.42306E-02 -1.94723E-02
+ 4 -1.19046E-02 -1.59240E-02
+4 0 *********** SCCS-ile-tyr
+ 1 4.49078E-01 -2.74446E-01
+ 2 -2.55459E-02 9.15112E-02
+ 3 -2.72392E-02 2.83834E-02
+ 4 -1.70035E-02 -1.89771E-02
+4 0 *********** SCCS-ile-ala
+ 1 4.03565E-01 -9.73049E-02
+ 2 -1.65085E-01 5.69215E-02
+ 3 -2.98332E-02 -3.68601E-02
+ 4 5.11142E-02 -3.60853E-03
+4 0 *********** SCCS-ile-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-ile-thr
- 1 -3.19331E-01 -2.78129E-01
- 2 2.64859E-01 -3.68305E-01
- 3 -9.64321E-02 -4.17280E-02
- 4 -1.00414E-01 -6.24471E-02
- 5 -7.11982E-02 -5.01324E-02
- 6 -5.10848E-02 5.66547E-02
-6 0 *********** SCCS-ile-ser
- 1 -4.69377E-01 -4.72659E-01
- 2 8.40766E-01 2.99629E-03
- 3 -1.17410E-01 -1.33685E-01
- 4 1.58318E-01 -4.26942E-03
- 5 -6.33359E-02 -3.32984E-02
- 6 3.23217E-02 -1.78609E-01
-6 0 *********** SCCS-ile-gln
- 1 -4.06047E-01 -3.29706E-01
- 2 3.02080E-01 -1.95983E-01
- 3 -1.17195E-01 -8.51338E-02
- 4 9.16907E-03 -1.65888E-03
- 5 -9.67471E-02 -4.13248E-02
- 6 -6.74363E-03 -6.95093E-02
-6 0 *********** SCCS-ile-asn
- 1 -3.91779E-01 -5.68894E-01
- 2 3.97636E-01 3.66844E-01
- 3 -6.26444E-02 -8.34805E-03
- 4 5.59487E-02 9.99808E-02
- 5 -2.22813E-02 -3.30375E-02
- 6 -1.89595E-02 -3.19876E-01
-6 0 *********** SCCS-ile-glu
- 1 -4.17017E-01 -3.24561E-01
- 2 2.90040E-01 -2.87396E-01
- 3 -1.31230E-01 -1.00111E-01
- 4 -1.75487E-02 -1.67929E-02
- 5 -1.12516E-01 -4.33961E-02
- 6 -1.68652E-02 -3.99147E-02
-6 0 *********** SCCS-ile-asp
- 1 -3.43233E-01 -4.49234E-01
- 2 5.34913E-01 2.02793E-01
- 3 -6.84339E-02 2.38160E-02
- 4 1.32494E-01 3.19377E-02
- 5 -8.10469E-02 1.40293E-02
- 6 4.47311E-02 -1.41734E-01
-6 0 *********** SCCS-ile-his
- 1 -4.82226E-01 -5.88413E-01
- 2 3.76655E-01 2.75091E-01
- 3 -8.24065E-02 -2.68400E-02
- 4 4.22172E-02 4.80822E-02
- 5 -5.39495E-02 -3.96245E-02
- 6 -2.79295E-02 -2.68305E-01
-6 0 *********** SCCS-ile-arg
- 1 -3.29820E-01 -2.07717E-01
- 2 -6.96591E-02 -3.11345E-01
- 3 -1.08863E-01 -1.46964E-01
- 4 -7.83059E-02 8.99063E-02
- 5 -7.90597E-02 -5.03337E-02
- 6 -5.35145E-02 -1.07962E-01
-6 0 *********** SCCS-ile-lys
- 1 -3.26846E-01 -1.68690E-01
- 2 -8.62982E-02 -3.42839E-01
- 3 -1.09530E-01 -1.95703E-01
- 4 -1.01321E-01 8.17160E-02
- 5 -7.61797E-02 -6.57440E-02
- 6 -5.80906E-02 -1.23863E-01
-6 0 *********** SCCS-ile-pro
- 1 -8.95187E-01 -5.72347E-01
- 2 -3.05340E-02 2.28174E+00
- 3 -5.52865E-02 3.85467E-01
- 4 -6.72103E-01 3.19480E-01
- 5 -4.16920E-01 2.00371E-01
- 6 -2.31081E-01 -7.14821E-01
-6 0 *********** SCCS-leu-cys
- 1 -2.49218E-01 -6.85998E-01
- 2 5.61460E-01 -4.98721E-03
- 3 -1.20421E-01 -1.18166E-01
- 4 8.35564E-02 -6.16545E-02
- 5 -1.69494E-01 -4.29556E-02
- 6 4.94242E-03 -1.71439E-01
-6 0 *********** SCCS-leu-met
- 1 -2.90525E-01 -5.02697E-01
- 2 1.10917E-01 -3.42050E-01
- 3 -1.74279E-01 -7.40614E-02
- 4 -4.56289E-02 1.42436E-02
- 5 -9.91967E-02 -3.33844E-02
- 6 -2.45275E-02 -4.78671E-02
-6 0 *********** SCCS-leu-phe
- 1 -3.12424E-01 -5.02028E-01
- 2 -1.38808E-01 -3.33835E-01
- 3 -1.35106E-01 -1.60210E-01
- 4 -1.23605E-01 9.06911E-02
- 5 -5.13431E-02 -8.65858E-02
- 6 -6.15301E-02 -1.87885E-01
-6 0 *********** SCCS-leu-ile
- 1 -2.51806E-01 -6.13216E-01
- 2 1.52660E-01 -3.78317E-01
- 3 -2.73995E-01 -8.73092E-02
- 4 -4.51981E-02 -2.53193E-02
- 5 -1.94259E-01 -2.60557E-02
- 6 -1.81751E-02 -2.82477E-02
-6 0 *********** SCCS-leu-leu
- 1 -3.36827E-01 -3.49138E-01
- 2 -1.33320E-01 -5.69843E-01
- 3 -1.56998E-01 -1.70189E-01
- 4 -1.11519E-01 9.50555E-02
- 5 -1.07886E-01 -6.89421E-02
- 6 -9.39830E-03 -7.95082E-02
-6 0 *********** SCCS-leu-val
- 1 -3.48806E-01 -4.94846E-01
- 2 1.05186E-01 -4.83487E-01
- 3 -1.82596E-01 -1.31634E-01
- 4 -1.55232E-01 8.41925E-02
- 5 -7.07517E-03 -7.70740E-02
- 6 -8.90066E-02 -1.14378E-01
-6 0 *********** SCCS-leu-trp
- 1 -3.28013E-01 -5.59379E-01
- 2 6.60342E-02 -2.55918E-01
- 3 -1.80637E-01 -7.39186E-02
- 4 -1.25598E-02 1.78130E-02
- 5 -1.31863E-01 -3.29401E-02
- 6 -1.20909E-02 -9.40927E-02
-6 0 *********** SCCS-leu-tyr
- 1 -3.29662E-01 -5.10630E-01
- 2 -1.26164E-01 -2.60216E-01
- 3 -1.68906E-01 -1.35382E-01
- 4 -5.79898E-02 6.73397E-02
- 5 -8.35187E-02 -5.55666E-02
- 6 -4.04080E-02 -1.64084E-01
-6 0 *********** SCCS-leu-ala
- 1 -3.49356E-01 -3.04182E-01
- 2 3.47609E-01 -4.74371E-01
- 3 -1.21154E-01 -5.30663E-02
- 4 -9.48709E-02 -6.71932E-03
- 5 -9.85826E-02 -4.98969E-02
- 6 -2.45818E-02 3.29046E-02
-6 0 *********** SCCS-leu-gly
+4 0 *********** SCCS-ile-thr
+ 1 6.20201E-01 -1.51004E-01
+ 2 -1.87224E-01 -2.62016E-02
+ 3 -6.88780E-02 -4.57481E-02
+ 4 2.01786E-02 -1.07393E-02
+4 0 *********** SCCS-ile-ser
+ 1 9.86260E-01 6.17463E-02
+ 2 6.62327E-02 -2.73558E-01
+ 3 1.10960E-01 -2.60774E-01
+ 4 3.83570E-02 -4.73275E-02
+4 0 *********** SCCS-ile-gln
+ 1 6.33544E-01 -1.88461E-01
+ 2 -1.11157E-01 -5.46044E-02
+ 3 -6.63764E-02 -7.88378E-02
+ 4 -2.90177E-04 -3.37399E-02
+4 0 *********** SCCS-ile-asn
+ 1 8.25454E-01 1.18023E-01
+ 2 9.19552E-02 -1.26947E-01
+ 3 1.45967E-01 -1.11375E-01
+ 4 2.12906E-02 -9.23171E-03
+4 0 *********** SCCS-ile-glu
+ 1 6.72081E-01 -2.47902E-01
+ 2 -1.35462E-01 -4.61728E-02
+ 3 -1.02405E-01 -6.77087E-02
+ 4 -6.17406E-03 -2.95507E-02
+4 0 *********** SCCS-ile-asp
+ 1 8.82886E-01 1.31154E-01
+ 2 1.26880E-01 -1.35348E-01
+ 3 1.68125E-01 -9.99270E-02
+ 4 2.84089E-02 -1.18548E-02
+4 0 *********** SCCS-ile-his
+ 1 7.94558E-01 1.75521E-01
+ 2 1.38135E-01 -1.15967E-01
+ 3 1.67239E-01 -3.45828E-03
+ 4 2.51629E-02 1.09876E-02
+4 0 *********** SCCS-ile-arg
+ 1 4.15725E-01 -3.00712E-01
+ 2 -6.50785E-02 9.28036E-02
+ 3 -3.20538E-02 2.66472E-02
+ 4 -8.49279E-03 -1.49651E-02
+4 0 *********** SCCS-ile-lys
+ 1 3.86892E-01 -2.73636E-01
+ 2 -1.12672E-01 1.29364E-01
+ 3 -3.92998E-02 3.02353E-02
+ 4 1.05440E-03 -2.13757E-02
+4 0 *********** SCCS-ile-pro
+ 1 1.10677E+00 1.63062E-01
+ 2 1.50623E-01 -4.22318E-01
+ 3 2.98202E-01 -2.99543E-01
+ 4 1.21923E-01 -2.54283E-02
+4 0 *********** SCCS-leu-cys
+ 1 5.94172E-01 1.73408E-01
+ 2 -4.73314E-02 -4.02620E-01
+ 3 9.12043E-02 2.01775E-02
+ 4 -1.81725E-02 4.15779E-02
+4 0 *********** SCCS-leu-met
+ 1 4.50214E-01 -4.84057E-02
+ 2 -3.11550E-01 -6.43377E-02
+ 3 -1.88595E-02 2.46353E-03
+ 4 3.13201E-02 1.89536E-02
+4 0 *********** SCCS-leu-phe
+ 1 4.47533E-01 -7.27249E-02
+ 2 -3.24192E-01 1.23022E-01
+ 3 -1.38368E-02 -1.16926E-02
+ 4 3.17776E-02 -2.62258E-02
+4 0 *********** SCCS-leu-ile
+ 1 5.38275E-01 -3.28620E-02
+ 2 -3.61398E-01 -1.84453E-01
+ 3 -1.26381E-03 -4.46188E-03
+ 4 3.51930E-02 2.87682E-02
+4 0 *********** SCCS-leu-leu
+ 1 3.93440E-01 -1.90873E-01
+ 2 -5.15508E-01 1.28112E-01
+ 3 -3.48570E-02 -1.12793E-02
+ 4 5.06812E-02 -1.16744E-02
+4 0 *********** SCCS-leu-val
+ 1 4.86868E-01 -7.00880E-02
+ 2 -4.72459E-01 -1.31204E-01
+ 3 -3.24814E-02 -2.39810E-02
+ 4 5.04527E-02 3.87129E-02
+4 0 *********** SCCS-leu-trp
+ 1 4.99228E-01 -6.01644E-02
+ 2 -2.56724E-01 -1.84632E-02
+ 3 3.00625E-03 -6.97844E-03
+ 4 3.48385E-02 4.33609E-04
+4 0 *********** SCCS-leu-tyr
+ 1 4.44213E-01 -7.33654E-02
+ 2 -2.88693E-01 1.26663E-01
+ 3 -1.36961E-02 -8.27957E-03
+ 4 2.22349E-02 -1.54084E-02
+4 0 *********** SCCS-leu-ala
+ 1 3.52407E-01 9.90197E-03
+ 2 -4.25254E-01 -2.87061E-01
+ 3 -9.77948E-03 1.04495E-02
+ 4 1.24345E-02 6.57671E-02
+4 0 *********** SCCS-leu-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-leu-thr
- 1 -1.72571E-01 -5.54925E-01
- 2 3.17232E-01 -3.25933E-01
- 3 -2.07871E-01 -2.53780E-01
- 4 -1.41440E-01 -1.26154E-02
- 5 -5.92041E-02 -7.95712E-02
- 6 -1.01076E-01 -1.74839E-01
-6 0 *********** SCCS-leu-ser
- 1 -4.74879E-01 -8.14550E-01
- 2 7.98263E-01 1.95635E-01
- 3 -6.60844E-03 -1.62053E-01
- 4 1.29202E-01 8.27874E-02
- 5 7.47400E-02 -4.48376E-02
- 6 1.40053E-02 -3.81815E-01
-6 0 *********** SCCS-leu-gln
- 1 -3.25690E-01 -5.69581E-01
- 2 2.63441E-01 -2.11752E-01
- 3 -1.40460E-01 -5.26245E-02
- 4 4.25378E-02 1.66858E-02
- 5 -1.00321E-01 -2.63036E-02
- 6 4.44963E-03 -9.41635E-02
-6 0 *********** SCCS-leu-asn
- 1 -2.26826E-01 -7.13740E-01
- 2 4.76870E-01 3.03841E-01
- 3 -1.07653E-01 9.54672E-03
- 4 1.51007E-01 2.03519E-02
- 5 -1.62452E-01 5.04810E-03
- 6 5.21187E-02 -2.25646E-01
-6 0 *********** SCCS-leu-glu
- 1 -3.52949E-01 -5.96190E-01
- 2 2.60448E-01 -3.30297E-01
- 3 -1.72790E-01 -6.52391E-02
- 4 1.24512E-02 -1.77719E-02
- 5 -1.28543E-01 -3.04144E-02
- 6 -4.06654E-03 -4.01179E-02
-6 0 *********** SCCS-leu-asp
- 1 -1.28529E-01 -5.77499E-01
- 2 6.22101E-01 1.47609E-01
- 3 -1.37239E-01 2.56708E-02
- 4 1.63598E-01 1.63447E-02
- 5 -1.24655E-01 -1.47705E-02
- 6 6.35426E-02 -1.50020E-01
-6 0 *********** SCCS-leu-his
- 1 -2.64819E-01 -7.66118E-01
- 2 3.92361E-01 3.09038E-01
- 3 -1.28562E-01 -6.93224E-02
- 4 5.94849E-02 -7.13782E-03
- 5 -9.25568E-02 -2.07811E-02
- 6 1.15707E-02 -2.84113E-01
-6 0 *********** SCCS-leu-arg
- 1 -3.42665E-01 -4.06661E-01
- 2 -4.60374E-02 -3.28852E-01
- 3 -1.47526E-01 -1.28543E-01
- 4 -9.79422E-02 8.55661E-02
- 5 -5.49528E-02 -5.43999E-02
- 6 -5.00766E-02 -1.28551E-01
-6 0 *********** SCCS-leu-lys
- 1 -3.22036E-01 -3.94770E-01
- 2 6.92088E-03 -4.58561E-01
- 3 -1.71484E-01 -8.83143E-02
- 4 -4.55712E-02 8.21355E-02
- 5 -1.54150E-01 -4.61641E-02
- 6 5.99116E-03 -6.20385E-02
-6 0 *********** SCCS-leu-pro
- 1 -1.69766E+01 -9.28976E-01
- 2 1.53398E+01 2.14294E+00
- 3 -1.53132E+01 8.50123E-01
- 4 1.49694E+01 -5.86703E-02
- 5 -1.64306E+01 6.05533E-01
- 6 7.77414E+00 2.44536E-01
-6 0 *********** SCCS-val-cys
- 1 -5.08127E-01 -1.22833E+00
- 2 1.75422E-01 -2.31780E-01
- 3 -2.42711E-01 1.24791E-02
- 4 1.10213E-01 -4.72575E-02
- 5 -1.93504E-01 -4.47106E-02
- 6 7.72327E-03 -1.33976E-01
-6 0 *********** SCCS-val-met
- 1 -4.67615E-01 -6.81299E-01
- 2 -1.14903E-01 -2.96704E-01
- 3 -1.64393E-01 -4.68767E-02
- 4 -4.51223E-02 5.96671E-02
- 5 -8.21649E-02 -6.74528E-02
- 6 -4.49196E-02 -1.36428E-01
-6 0 *********** SCCS-val-phe
- 1 -5.66763E-01 -7.49695E-01
- 2 -2.74294E-01 -1.15026E-01
- 3 -1.50105E-01 -2.37182E-01
- 4 -1.49918E-01 1.65041E-01
- 5 4.24887E-02 -1.41044E-01
- 6 -1.49910E-01 -4.37427E-01
-6 0 *********** SCCS-val-ile
- 1 -4.72304E-01 -8.97826E-01
- 2 -1.39904E-01 -3.21496E-01
- 3 -2.68467E-01 -9.37305E-03
- 4 -9.77386E-02 1.37961E-01
- 5 2.74672E-02 -6.24458E-02
- 6 -8.73308E-02 -1.95481E-01
-6 0 *********** SCCS-val-leu
- 1 -4.99294E-01 -5.76277E-01
- 2 -2.66861E-01 -4.61833E-01
- 3 -1.98833E-01 -5.36916E-02
- 4 2.32649E-02 1.02889E-01
- 5 -1.94799E-01 -5.97384E-02
- 6 1.20541E-02 -8.75408E-02
-6 0 *********** SCCS-val-val
- 1 -5.72548E-01 -7.22372E-01
- 2 -1.01544E-01 -3.29190E-01
- 3 -2.16137E-01 -1.70961E-01
- 4 -2.57871E-01 2.16216E-01
- 5 1.37429E-01 -8.07120E-02
- 6 -1.41239E-01 -3.08226E-01
-6 0 *********** SCCS-val-trp
- 1 -5.73204E-01 -7.57398E-01
- 2 -1.10157E-01 -1.24961E-01
- 3 -1.30925E-01 -7.42745E-02
- 4 -4.72776E-02 6.88725E-03
- 5 -1.10282E-01 -3.03642E-02
- 6 -3.59409E-02 -1.58460E-01
-6 0 *********** SCCS-val-tyr
- 1 -5.99614E-01 -7.19719E-01
- 2 -2.88389E-01 -4.15766E-02
- 3 -1.43902E-01 -1.91628E-01
- 4 -1.34170E-01 1.98232E-01
- 5 7.76092E-02 -1.30236E-01
- 6 -1.42821E-01 -4.50663E-01
-6 0 *********** SCCS-val-ala
- 1 -4.04349E-01 -5.89275E-01
- 2 3.26142E-01 -5.36841E-01
- 3 -4.29884E-01 1.08914E-02
- 4 1.90257E-01 4.09288E-02
- 5 -3.21138E-01 2.87473E-02
- 6 1.37507E-01 7.66460E-02
-6 0 *********** SCCS-val-gly
+4 0 *********** SCCS-leu-thr
+ 1 5.30410E-01 -3.02183E-02
+ 2 -3.40930E-01 -2.50663E-01
+ 3 -1.72778E-02 -3.12795E-02
+ 4 6.50734E-03 4.50499E-02
+4 0 *********** SCCS-leu-ser
+ 1 6.43329E-01 2.88516E-01
+ 2 1.45392E-01 -5.44840E-01
+ 3 1.89139E-01 4.54212E-02
+ 4 5.20574E-03 6.18441E-03
+4 0 *********** SCCS-leu-gln
+ 1 5.38355E-01 -9.84240E-03
+ 2 -2.31182E-01 -2.17751E-01
+ 3 4.74929E-02 -4.53414E-02
+ 4 2.17601E-03 3.35150E-02
+4 0 *********** SCCS-leu-asn
+ 1 5.90026E-01 2.87928E-01
+ 2 1.94468E-01 -4.17227E-01
+ 3 1.25681E-01 4.82303E-02
+ 4 -6.52887E-05 2.85218E-02
+4 0 *********** SCCS-leu-glu
+ 1 5.67262E-01 -4.93095E-02
+ 2 -3.05894E-01 -1.96980E-01
+ 3 3.23051E-02 -6.29242E-02
+ 4 1.22491E-02 2.40107E-02
+4 0 *********** SCCS-leu-asp
+ 1 6.22202E-01 3.02516E-01
+ 2 2.07573E-01 -4.31691E-01
+ 3 1.27351E-01 4.61920E-02
+ 4 -8.60483E-04 2.43449E-02
+4 0 *********** SCCS-leu-his
+ 1 5.86765E-01 2.88627E-01
+ 2 2.35091E-01 -3.01746E-01
+ 3 3.08047E-02 9.85179E-02
+ 4 1.02471E-02 7.74650E-03
+4 0 *********** SCCS-leu-arg
+ 1 4.15115E-01 -1.37915E-01
+ 2 -3.18066E-01 8.40315E-02
+ 3 -2.25748E-02 1.54698E-02
+ 4 2.14297E-02 -9.37111E-03
+4 0 *********** SCCS-leu-lys
+ 1 3.77420E-01 -1.69429E-01
+ 2 -3.94650E-01 8.02192E-02
+ 3 -4.51308E-02 8.84393E-03
+ 4 2.97845E-02 2.48893E-03
+4 0 *********** SCCS-leu-pro
+ 1 7.16084E-01 2.99786E-01
+ 2 1.86283E-01 -6.03837E-01
+ 3 2.55575E-01 7.04726E-02
+ 4 1.91405E-02 -4.06397E-03
+4 0 *********** SCCS-val-cys
+ 1 7.86466E-01 -4.29816E-03
+ 2 -4.32969E-03 -2.08880E-01
+ 3 8.92767E-02 -7.77737E-02
+ 4 1.70589E-02 2.40084E-03
+4 0 *********** SCCS-val-met
+ 1 4.82523E-01 -1.71997E-01
+ 2 -1.79550E-01 4.18869E-03
+ 3 -4.20704E-02 1.06050E-02
+ 4 5.12664E-03 -9.63187E-03
+4 0 *********** SCCS-val-phe
+ 1 4.51288E-01 -2.28428E-01
+ 2 -1.51994E-01 1.02467E-01
+ 3 -5.40453E-02 -6.33436E-04
+ 4 -1.17698E-02 -6.75950E-03
+4 0 *********** SCCS-val-ile
+ 1 5.99794E-01 -1.49710E-01
+ 2 -2.21716E-01 -1.00818E-01
+ 3 -7.56670E-02 -4.49988E-02
+ 4 2.23437E-02 1.38860E-04
+4 0 *********** SCCS-val-leu
+ 1 4.14638E-01 -2.61707E-01
+ 2 -2.82127E-01 1.46116E-01
+ 3 -5.38285E-02 4.44781E-02
+ 4 9.79193E-03 -6.08394E-02
+4 0 *********** SCCS-val-val
+ 1 5.31517E-01 -2.21076E-01
+ 2 -2.82958E-01 -2.56610E-02
+ 3 -7.96155E-02 2.15670E-03
+ 4 1.47594E-02 -2.10170E-02
+4 0 *********** SCCS-val-trp
+ 1 5.21376E-01 -1.78759E-01
+ 2 -1.31968E-01 1.73530E-04
+ 3 -5.86612E-02 -8.79356E-03
+ 4 -4.52690E-03 -1.10914E-02
+4 0 *********** SCCS-val-tyr
+ 1 4.36795E-01 -2.36531E-01
+ 2 -1.37645E-01 1.01878E-01
+ 3 -5.17500E-02 -1.33638E-03
+ 4 -1.13990E-02 -8.80492E-03
+4 0 *********** SCCS-val-ala
+ 1 4.02626E-01 1.40449E-02
+ 2 -2.57620E-01 -1.04836E-01
+ 3 -1.72425E-02 -4.38215E-03
+ 4 6.62607E-02 1.47455E-02
+4 0 *********** SCCS-val-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-val-thr
- 1 -3.48995E-01 -6.96045E-01
- 2 1.06333E-01 -4.36133E-01
- 3 -2.97050E-01 -1.37189E-01
- 4 -1.49435E-01 -5.41107E-04
- 5 -1.19870E-01 -2.70059E-02
- 6 -6.05371E-02 -6.72354E-02
-6 0 *********** SCCS-val-ser
- 1 -8.11529E-01 -1.78847E+00
- 2 3.14178E-01 -1.76381E-01
- 3 -2.60278E-01 -2.46390E-01
- 4 -4.55604E-02 7.42253E-03
- 5 -1.02370E-01 -8.89302E-02
- 6 -7.15634E-02 -4.52371E-01
-6 0 *********** SCCS-val-gln
- 1 -5.71382E-01 -8.23637E-01
- 2 5.13980E-02 -1.63906E-01
- 3 -1.10240E-01 -6.85517E-02
- 4 -2.23447E-02 -9.12615E-03
- 5 -8.15237E-02 -7.69131E-02
- 6 -5.42256E-02 -1.73653E-01
-6 0 *********** SCCS-val-asn
- 1 -1.69305E-01 -1.12563E+00
- 2 3.32025E-01 8.51981E-02
- 3 -1.46261E-01 -8.61763E-02
- 4 4.97252E-02 9.93696E-02
- 5 -1.97415E-01 -7.82931E-02
- 6 3.50810E-02 -3.88527E-01
-6 0 *********** SCCS-val-glu
- 1 -6.53174E-01 -8.94631E-01
- 2 -3.97347E-03 -2.46543E-01
- 3 -1.46293E-01 -5.22161E-02
- 4 -4.02746E-02 4.35529E-03
- 5 -1.04705E-01 -6.60692E-02
- 6 -4.56520E-02 -1.55539E-01
-6 0 *********** SCCS-val-asp
- 1 3.77343E-02 -1.03201E+00
- 2 5.59251E-01 -1.04204E-01
- 3 -2.48617E-01 -3.11181E-01
- 4 -1.48392E-03 1.20016E-01
- 5 1.53107E-01 -1.30515E-01
- 6 -9.11765E-02 -4.89330E-01
-6 0 *********** SCCS-val-his
- 1 -1.81605E-01 -1.35929E+00
- 2 4.77597E-02 1.95803E-01
- 3 -1.58777E-01 -8.74716E-02
- 4 -3.51418E-02 4.17012E-02
- 5 -5.43388E-02 -6.84646E-02
- 6 -5.66821E-02 -4.16107E-01
-6 0 *********** SCCS-val-arg
- 1 -5.32337E-01 -4.97573E-01
- 2 -1.57505E-01 -2.14989E-01
- 3 -1.68156E-01 -6.54746E-02
- 4 -4.61937E-02 6.33402E-02
- 5 -1.03468E-01 -6.34401E-02
- 6 -4.42908E-02 -1.39737E-01
-6 0 *********** SCCS-val-lys
- 1 -4.59219E-01 -5.37800E-01
- 2 -1.84523E-01 -3.46324E-01
- 3 -1.75077E-01 -4.43680E-02
- 4 -2.93453E-02 9.23726E-02
- 5 -1.16393E-01 -6.40328E-02
- 6 -1.80163E-02 -1.13905E-01
-6 0 *********** SCCS-val-pro
- 1 -2.41642E+00 2.08252E+00
- 2 2.76103E-01 2.43649E+00
- 3 -7.14083E-01 -4.46788E-01
- 4 -7.05393E-01 7.99817E-01
- 5 4.02375E-02 -1.54129E-01
- 6 -4.87454E-01 -1.36105E+00
-6 0 *********** SCCS-trp-cys
- 1 -4.48284E-01 -1.18396E+00
- 2 1.44145E-01 -2.24227E-01
- 3 -1.91893E-01 -9.55712E-02
- 4 -2.53007E-02 3.93433E-02
- 5 -4.14547E-02 -5.83266E-02
- 6 -5.43771E-02 -2.60738E-01
-6 0 *********** SCCS-trp-met
- 1 -4.64991E-01 -6.70876E-01
- 2 -7.03091E-02 -2.49665E-01
- 3 -1.58999E-01 -7.11774E-02
- 4 -8.07247E-02 7.24877E-02
- 5 -4.97798E-02 -7.04688E-02
- 6 -5.98883E-02 -1.75993E-01
-6 0 *********** SCCS-trp-phe
- 1 -5.18748E-01 -7.41114E-01
- 2 -2.20139E-01 -1.87387E-01
- 3 -1.32501E-01 -1.60661E-01
- 4 -7.45539E-02 9.89325E-02
- 5 -3.23087E-02 -7.22612E-02
- 6 -8.61964E-02 -2.74166E-01
-6 0 *********** SCCS-trp-ile
- 1 -5.17656E-01 -8.52654E-01
- 2 -1.06775E-01 -2.26708E-01
- 3 -2.24799E-01 -8.46696E-02
- 4 -1.33455E-01 1.50851E-01
- 5 3.58038E-02 -5.96966E-02
- 6 -8.56653E-02 -2.63603E-01
-6 0 *********** SCCS-trp-leu
- 1 -4.73686E-01 -6.08987E-01
- 2 -2.28889E-01 -4.41430E-01
- 3 -2.37775E-01 -4.53232E-02
- 4 2.39357E-02 7.37284E-02
- 5 -2.10380E-01 -4.42244E-02
- 6 2.31318E-02 -6.58227E-02
-6 0 *********** SCCS-trp-val
- 1 -5.21572E-01 -7.40083E-01
- 2 -1.01166E-01 -2.86204E-01
- 3 -1.99181E-01 -1.62018E-01
- 4 -1.86917E-01 1.99988E-01
- 5 6.75405E-02 -5.62877E-02
- 6 -1.18237E-01 -2.95003E-01
-6 0 *********** SCCS-trp-trp
- 1 -5.54205E-01 -7.54113E-01
- 2 -1.43472E-01 -1.09025E-01
- 3 -1.44082E-01 -6.62824E-02
- 4 -1.89042E-02 3.00530E-02
- 5 -1.20752E-01 -5.50070E-02
- 6 -3.24228E-02 -1.93303E-01
-6 0 *********** SCCS-trp-tyr
- 1 -5.47196E-01 -7.52212E-01
- 2 -2.28131E-01 -1.27066E-01
- 3 -1.42024E-01 -2.21094E-01
- 4 -1.07429E-01 1.29316E-01
- 5 4.17529E-02 -1.18433E-01
- 6 -1.12539E-01 -3.85618E-01
-6 0 *********** SCCS-trp-ala
- 1 -2.18613E-01 -6.45344E-01
- 2 2.30947E-01 -4.63063E-01
- 3 -3.38638E-01 -3.67520E-02
- 4 7.39973E-02 2.36394E-03
- 5 -2.66254E-01 -1.64697E-02
- 6 7.17476E-02 1.94584E-02
-6 0 *********** SCCS-trp-gly
+4 0 *********** SCCS-val-thr
+ 1 5.86762E-01 -1.46511E-01
+ 2 -2.13679E-01 -1.03577E-01
+ 3 -7.94667E-02 -4.83725E-02
+ 4 2.09928E-02 -4.62998E-03
+4 0 *********** SCCS-val-ser
+ 1 1.04735E+00 4.99137E-02
+ 2 2.14269E-01 -3.39805E-01
+ 3 2.44740E-01 -8.40160E-02
+ 4 5.29428E-02 -4.33972E-02
+4 0 *********** SCCS-val-gln
+ 1 6.13296E-01 -1.73183E-01
+ 2 -1.26476E-01 -1.28614E-01
+ 3 -3.71179E-02 -7.86053E-02
+ 4 1.04799E-02 -2.01331E-02
+4 0 *********** SCCS-val-asn
+ 1 8.04143E-01 1.57745E-01
+ 2 1.82443E-01 -2.61981E-01
+ 3 9.86430E-02 -3.13450E-02
+ 4 4.11567E-02 1.32916E-02
+4 0 *********** SCCS-val-glu
+ 1 6.46327E-01 -2.34941E-01
+ 2 -1.66375E-01 -1.21363E-01
+ 3 -6.35693E-02 -8.08871E-02
+ 4 9.52973E-03 -2.25330E-02
+4 0 *********** SCCS-val-asp
+ 1 8.60112E-01 1.77381E-01
+ 2 2.19171E-01 -2.83089E-01
+ 3 1.35769E-01 -5.49904E-02
+ 4 3.53350E-02 1.97050E-03
+4 0 *********** SCCS-val-his
+ 1 7.50465E-01 2.17826E-01
+ 2 2.31690E-01 -2.13623E-01
+ 3 1.08163E-01 4.23888E-03
+ 4 1.00893E-02 4.01857E-02
+4 0 *********** SCCS-val-arg
+ 1 4.10847E-01 -2.63199E-01
+ 2 -1.51817E-01 6.81096E-02
+ 3 -3.92104E-02 2.09606E-02
+ 4 1.06147E-02 -1.12527E-02
+4 0 *********** SCCS-val-lys
+ 1 3.76811E-01 -2.56016E-01
+ 2 -2.25150E-01 1.08778E-01
+ 3 -4.37858E-02 5.46755E-02
+ 4 8.88439E-03 -2.55896E-02
+4 0 *********** SCCS-val-pro
+ 1 1.03436E+00 1.00714E-01
+ 2 1.86406E-01 -4.96539E-01
+ 3 2.62543E-01 -3.07019E-01
+ 4 8.02174E-02 -9.14531E-02
+4 0 *********** SCCS-trp-cys
+ 1 4.85138E-01 -1.82979E-01
+ 2 1.96020E-01 6.48263E-02
+ 3 -2.52414E-02 -8.54147E-02
+ 4 7.93224E-03 1.31628E-02
+4 0 *********** SCCS-trp-met
+ 1 2.48041E-01 -2.84325E-01
+ 2 1.30070E-01 -1.01583E-01
+ 3 -3.33324E-02 -1.77276E-02
+ 4 -3.97627E-03 -6.68479E-03
+4 0 *********** SCCS-trp-phe
+ 1 2.19398E-01 -3.43636E-01
+ 2 7.09310E-02 -1.59341E-01
+ 3 -3.49108E-02 1.35400E-02
+ 4 -1.17105E-02 2.68615E-03
+4 0 *********** SCCS-trp-ile
+ 1 3.39621E-01 -3.07163E-01
+ 2 1.91920E-01 -1.12493E-01
+ 3 -3.90083E-02 -2.87568E-02
+ 4 5.73771E-04 -1.45520E-02
+4 0 *********** SCCS-trp-leu
+ 1 1.92352E-01 -3.39104E-01
+ 2 1.12441E-01 -1.87719E-01
+ 3 -2.48803E-02 5.17637E-03
+ 4 -2.43256E-02 -1.13261E-02
+4 0 *********** SCCS-trp-val
+ 1 3.04400E-01 -3.17984E-01
+ 2 1.79017E-01 -1.32345E-01
+ 3 -3.70638E-02 -1.81856E-02
+ 4 3.47239E-03 -1.33026E-02
+4 0 *********** SCCS-trp-trp
+ 1 2.43296E-01 -3.18081E-01
+ 2 1.06406E-01 -1.38401E-01
+ 3 -3.34627E-02 -1.13739E-03
+ 4 -4.60639E-03 2.78278E-03
+4 0 *********** SCCS-trp-tyr
+ 1 2.07853E-01 -3.39702E-01
+ 2 6.52886E-02 -1.46562E-01
+ 3 -2.61363E-02 1.94548E-02
+ 4 -1.14587E-02 1.22331E-03
+4 0 *********** SCCS-trp-ala
+ 1 2.88980E-01 -1.77235E-01
+ 2 2.16084E-01 -1.60516E-02
+ 3 4.02341E-04 -4.80763E-02
+ 4 1.04394E-02 -4.60249E-02
+4 0 *********** SCCS-trp-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-trp-thr
- 1 -3.73142E-01 -6.85240E-01
- 2 6.95429E-02 -4.04444E-01
- 3 -2.94958E-01 -1.08692E-01
- 4 -6.88820E-02 8.37906E-03
- 5 -1.47169E-01 -1.16512E-02
- 6 -1.99472E-02 -5.45492E-02
-6 0 *********** SCCS-trp-ser
- 1 -5.72191E-01 -1.73897E+00
- 2 3.75892E-01 -2.39716E-01
- 3 -1.60353E-01 -1.43903E-01
- 4 1.14520E-01 -3.34018E-02
- 5 -2.12776E-01 1.55122E-02
- 6 9.41949E-03 -2.49871E-01
-6 0 *********** SCCS-trp-gln
- 1 -5.32836E-01 -8.20032E-01
- 2 2.87967E-02 -1.20752E-01
- 3 -1.28860E-01 -1.06653E-01
- 4 -5.02384E-02 2.43303E-02
- 5 -7.07573E-02 -6.81090E-02
- 6 -5.42439E-02 -2.27826E-01
-6 0 *********** SCCS-trp-asn
- 1 9.80713E-02 -1.09128E+00
- 2 1.76599E-01 1.47477E-01
- 3 -4.67979E-02 -1.39269E-01
- 4 -4.23642E-02 3.16019E-02
- 5 -5.96547E-02 -4.35885E-02
- 6 -4.80702E-02 -3.58565E-01
-6 0 *********** SCCS-trp-glu
- 1 -6.30771E-01 -8.83315E-01
- 2 -2.66606E-02 -2.04321E-01
- 3 -1.53341E-01 -8.88564E-02
- 4 -6.19404E-02 2.49300E-02
- 5 -8.18937E-02 -7.13081E-02
- 6 -6.16335E-02 -2.04751E-01
-6 0 *********** SCCS-trp-asp
- 1 1.99860E-01 -9.37262E-01
- 2 5.05636E-01 4.91373E-02
- 3 -1.96814E-02 -2.81295E-01
- 4 -5.09498E-02 2.48404E-02
- 5 9.16954E-03 -1.10693E-01
- 6 -9.27262E-02 -4.23157E-01
-6 0 *********** SCCS-trp-his
- 1 -4.56231E-02 -1.31960E+00
- 2 -1.11050E-02 1.24647E-01
- 3 -1.16496E-01 -3.67834E-02
- 4 -3.05527E-02 7.21364E-02
- 5 -6.13869E-02 -5.20078E-02
- 6 -6.34768E-02 -3.76992E-01
-6 0 *********** SCCS-trp-arg
- 1 -5.22101E-01 -5.20351E-01
- 2 -1.09536E-01 -2.26795E-01
- 3 -2.02612E-01 -4.92539E-02
- 4 2.01571E-02 3.71938E-02
- 5 -1.56698E-01 -3.42874E-02
- 6 -1.18273E-02 -9.68762E-02
-6 0 *********** SCCS-trp-lys
- 1 -4.28469E-01 -5.26256E-01
- 2 -1.85745E-01 -3.19636E-01
- 3 -1.69527E-01 -5.27355E-02
- 4 -5.07424E-02 7.21603E-02
- 5 -8.74315E-02 -5.31631E-02
- 6 -3.66357E-02 -1.01719E-01
-6 0 *********** SCCS-trp-pro
- 1 -2.73361E+00 2.12664E+00
- 2 3.01098E-01 1.99547E+00
- 3 -1.32265E+00 -3.62459E-01
- 4 -1.18304E-01 -4.05155E-01
- 5 -3.58510E-01 -2.36804E-01
- 6 3.90217E-01 -4.15373E-01
-6 0 *********** SCCS-tyr-cys
- 1 -3.87510E-01 -1.20833E+00
- 2 3.22669E-01 -3.57898E-02
- 3 -2.36645E-01 -1.33782E-01
- 4 -7.13273E-02 -2.07493E-04
- 5 1.15887E-01 -6.74428E-02
- 6 -1.18548E-01 -3.17289E-01
-6 0 *********** SCCS-tyr-met
- 1 -4.11264E-01 -6.88410E-01
- 2 -4.33420E-02 -3.02846E-01
- 3 -1.72364E-01 -6.50718E-02
- 4 -7.02888E-02 5.70206E-02
- 5 -4.67840E-02 -5.79613E-02
- 6 -5.72579E-02 -1.35510E-01
-6 0 *********** SCCS-tyr-phe
- 1 -4.91138E-01 -7.58770E-01
- 2 -1.96839E-01 -2.99334E-01
- 3 -2.40163E-01 -1.82708E-02
- 4 7.61872E-02 1.58644E-02
- 5 -2.20125E-01 -5.01634E-02
- 6 1.88156E-02 -8.41331E-02
-6 0 *********** SCCS-tyr-ile
- 1 -4.48345E-01 -8.47062E-01
- 2 -1.12874E-01 -4.11658E-01
- 3 -2.70935E-01 -7.47193E-04
- 4 -1.07202E-01 1.04382E-01
- 5 -3.13915E-02 -1.35150E-02
- 6 -4.52254E-02 -9.23647E-02
-6 0 *********** SCCS-tyr-leu
- 1 -4.21104E-01 -5.41405E-01
- 2 -2.78550E-01 -5.65247E-01
- 3 -1.46415E-01 -8.72502E-02
- 4 -1.27358E-01 1.43909E-01
- 5 -6.49960E-02 -8.22910E-02
- 6 -3.87224E-02 -1.12511E-01
-6 0 *********** SCCS-tyr-val
- 1 -4.78476E-01 -7.27720E-01
- 2 -6.30069E-03 -5.21135E-01
- 3 -4.16647E-01 -5.69677E-03
- 4 -1.93008E-03 5.29606E-02
- 5 -2.20459E-01 1.79385E-03
- 6 5.22447E-02 4.32833E-03
-6 0 *********** SCCS-tyr-trp
- 1 -5.09422E-01 -7.75589E-01
- 2 -1.67638E-01 -1.78565E-01
- 3 -1.28118E-01 -9.47470E-02
- 4 -5.30020E-02 4.44236E-02
- 5 -7.45042E-02 -7.53422E-02
- 6 -6.45105E-02 -2.13918E-01
-6 0 *********** SCCS-tyr-tyr
- 1 -4.65337E-01 -7.60848E-01
- 2 -2.24418E-01 -2.26474E-01
- 3 -1.48839E-01 -8.45522E-02
- 4 -1.63466E-02 4.55127E-02
- 5 -1.14927E-01 -7.76143E-02
- 6 -5.74827E-02 -1.94198E-01
-6 0 *********** SCCS-tyr-ala
- 1 -2.99193E-01 -6.31838E-01
- 2 3.13387E-01 -3.75316E-01
- 3 -2.08453E-01 -2.48901E-01
- 4 -2.53717E-01 1.93717E-01
- 5 1.93621E-01 -1.13822E-01
- 6 -1.80867E-01 -3.39802E-01
-6 0 *********** SCCS-tyr-gly
+4 0 *********** SCCS-trp-thr
+ 1 3.33794E-01 -2.86700E-01
+ 2 2.17694E-01 -9.80045E-02
+ 3 -2.38907E-02 -2.66965E-02
+ 4 8.30399E-03 -1.35058E-02
+4 0 *********** SCCS-trp-ser
+ 1 6.00894E-01 -1.14686E-01
+ 2 2.16336E-01 1.32206E-01
+ 3 -9.68653E-03 -9.15954E-02
+ 4 9.12456E-03 1.96290E-02
+4 0 *********** SCCS-trp-gln
+ 1 3.15699E-01 -2.87964E-01
+ 2 1.65908E-01 -6.56960E-02
+ 3 -3.91986E-02 9.97324E-04
+ 4 -1.62928E-03 -8.66838E-03
+4 0 *********** SCCS-trp-asn
+ 1 5.22114E-01 -6.16801E-02
+ 2 1.43744E-01 1.28932E-01
+ 3 3.34487E-02 -3.92939E-02
+ 4 7.68923E-03 1.87095E-02
+4 0 *********** SCCS-trp-glu
+ 1 3.28314E-01 -3.32187E-01
+ 2 1.84183E-01 -1.06422E-01
+ 3 -4.84187E-02 2.23351E-03
+ 4 -4.18345E-03 -1.77328E-02
+4 0 *********** SCCS-trp-asp
+ 1 5.60666E-01 -5.93245E-02
+ 2 1.69393E-01 1.37331E-01
+ 3 4.09960E-02 -3.79390E-02
+ 4 1.43053E-02 1.99879E-02
+4 0 *********** SCCS-trp-his
+ 1 4.84972E-01 -5.97378E-02
+ 2 1.22201E-01 1.14444E-01
+ 3 3.44912E-02 -5.65853E-02
+ 4 1.06022E-02 1.47781E-03
+4 0 *********** SCCS-trp-arg
+ 1 1.76449E-01 -3.23649E-01
+ 2 7.61235E-02 -1.50410E-01
+ 3 -3.06091E-02 2.92860E-03
+ 4 -1.56412E-02 -3.18537E-03
+4 0 *********** SCCS-trp-lys
+ 1 1.56107E-01 -2.99490E-01
+ 2 9.54620E-02 -1.43133E-01
+ 3 -1.39722E-02 -2.58350E-03
+ 4 -1.16648E-02 -9.91106E-03
+4 0 *********** SCCS-trp-pro
+ 1 5.68316E-01 -1.01008E-01
+ 2 2.97583E-01 1.87430E-01
+ 3 -1.19631E-02 -6.91847E-02
+ 4 1.36279E-02 3.97384E-03
+4 0 *********** SCCS-tyr-cys
+ 1 5.55259E-01 2.14259E-02
+ 2 1.98180E-01 -1.44708E-01
+ 3 -1.37493E-01 -6.34694E-02
+ 4 3.34960E-02 1.80364E-02
+4 0 *********** SCCS-tyr-met
+ 1 3.66448E-01 -1.23226E-01
+ 2 -2.16214E-02 -1.63415E-01
+ 3 -7.70080E-02 2.82162E-02
+ 4 -2.89652E-02 -3.48982E-03
+4 0 *********** SCCS-tyr-phe
+ 1 3.32943E-01 -1.85915E-01
+ 2 -9.74173E-02 -1.42315E-01
+ 3 -4.09691E-02 1.02017E-01
+ 4 -4.72429E-02 3.46750E-02
+4 0 *********** SCCS-tyr-ile
+ 1 4.47979E-01 -1.18184E-01
+ 2 5.22640E-03 -2.12939E-01
+ 3 -1.25254E-01 1.77613E-02
+ 4 -1.89103E-02 -1.71523E-02
+4 0 *********** SCCS-tyr-leu
+ 1 3.19351E-01 -2.36058E-01
+ 2 -1.48965E-01 -1.87933E-01
+ 3 -4.73722E-02 9.45693E-02
+ 4 -6.97518E-02 -3.99825E-03
+4 0 *********** SCCS-tyr-val
+ 1 4.20060E-01 -1.66880E-01
+ 2 -3.05941E-02 -2.26764E-01
+ 3 -1.12217E-01 4.12918E-02
+ 4 -3.14988E-02 -3.87474E-02
+4 0 *********** SCCS-tyr-trp
+ 1 3.76306E-01 -1.38972E-01
+ 2 -4.73139E-02 -1.34862E-01
+ 3 -6.65524E-02 6.30932E-02
+ 4 -2.29209E-02 1.68061E-02
+4 0 *********** SCCS-tyr-tyr
+ 1 3.23069E-01 -1.81659E-01
+ 2 -9.14465E-02 -1.31407E-01
+ 3 -2.79885E-02 1.00003E-01
+ 4 -4.99827E-02 3.17112E-02
+4 0 *********** SCCS-tyr-ala
+ 1 3.31711E-01 -5.51802E-02
+ 2 4.32172E-02 -2.29156E-01
+ 3 -1.08502E-01 -7.32833E-02
+ 4 1.58578E-02 -6.28907E-02
+4 0 *********** SCCS-tyr-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-tyr-thr
- 1 -3.16814E-01 -6.97451E-01
- 2 1.55133E-01 -5.94716E-01
- 3 -2.72853E-01 -9.13668E-02
- 4 -6.74650E-02 -6.81674E-02
- 5 -1.45340E-01 -6.75570E-03
- 6 -2.25740E-02 6.24114E-02
-6 0 *********** SCCS-tyr-ser
- 1 -4.65735E-01 -1.65446E+00
- 2 6.29907E-01 -3.57058E-02
- 3 -1.99004E-01 -1.10672E-01
- 4 5.91414E-02 -7.68924E-02
- 5 -4.37221E-02 3.22634E-03
- 6 -3.94049E-02 -2.63064E-01
-6 0 *********** SCCS-tyr-gln
- 1 -4.81568E-01 -8.36739E-01
- 2 8.20154E-02 -1.63785E-01
- 3 -8.99512E-02 -1.02623E-01
- 4 -1.53615E-02 3.22598E-02
- 5 -4.60622E-02 -7.35226E-02
- 6 -5.11076E-02 -2.26461E-01
-6 0 *********** SCCS-tyr-asn
- 1 5.78726E-02 -1.09556E+00
- 2 2.29505E-01 2.64977E-01
- 3 -3.09193E-02 -1.59758E-01
- 4 -4.56856E-02 4.84772E-02
- 5 -1.08984E-02 -7.35328E-02
- 6 -6.35265E-02 -4.42554E-01
-6 0 *********** SCCS-tyr-glu
- 1 -5.73907E-01 -9.06378E-01
- 2 4.22463E-02 -2.62790E-01
- 3 -9.87536E-02 -1.02830E-01
- 4 -4.14298E-02 4.39334E-02
- 5 -3.73275E-02 -8.30798E-02
- 6 -6.52865E-02 -2.19827E-01
-6 0 *********** SCCS-tyr-asp
- 1 2.60759E-01 -8.72925E-01
- 2 5.19523E-01 5.69634E-02
- 3 -4.90372E-02 -1.62750E-01
- 4 4.20601E-02 3.52954E-02
- 5 -3.15888E-02 -5.83981E-02
- 6 -2.37225E-02 -3.19141E-01
-6 0 *********** SCCS-tyr-his
- 1 -6.01049E-02 -1.32350E+00
- 2 3.09132E-02 1.60375E-01
- 3 -1.51647E-01 -2.73955E-02
- 4 -2.43134E-02 4.27742E-02
- 5 -9.63423E-02 -5.10342E-02
- 6 -4.70408E-02 -3.60935E-01
-6 0 *********** SCCS-tyr-arg
- 1 -4.50758E-01 -5.53968E-01
- 2 -1.38765E-01 -3.14012E-01
- 3 -1.83397E-01 -5.93655E-02
- 4 -7.39288E-03 4.95774E-02
- 5 -1.21274E-01 -4.60344E-02
- 6 -2.67240E-02 -9.33134E-02
-6 0 *********** SCCS-tyr-lys
- 1 -4.13095E-01 -5.26386E-01
- 2 -1.53166E-01 -3.84123E-01
- 3 -1.63802E-01 -9.98995E-02
- 4 -1.04489E-01 1.25757E-01
- 5 -2.51877E-02 -6.26002E-02
- 6 -5.73001E-02 -1.52514E-01
-6 0 *********** SCCS-tyr-pro
- 1 -2.22229E+00 -1.37740E-01
- 2 -4.87112E-01 3.08271E+00
- 3 3.45549E-01 3.56667E-01
- 4 -8.41963E-01 -1.17460E-01
- 5 -5.71056E-01 5.93003E-01
- 6 1.30769E-01 -2.77334E-01
-6 0 *********** SCCS-ala-cys
- 1 -8.78004E-01 5.01767E-02
- 2 2.69999E-01 2.21404E-01
- 3 -1.07276E-01 -1.92933E-02
- 4 -7.20909E-02 7.56565E-02
- 5 -2.68208E-02 -2.07365E-02
- 6 -5.85231E-02 -1.47370E-01
-6 0 *********** SCCS-ala-met
- 1 -5.35076E-01 3.07454E-01
- 2 7.63702E-02 -1.54725E-02
- 3 -3.61258E-02 -1.09351E-01
- 4 -5.43513E-02 8.28805E-02
- 5 -4.77047E-02 -4.50729E-02
- 6 -4.00031E-02 -9.37844E-02
-6 0 *********** SCCS-ala-phe
- 1 -4.22387E-01 3.96474E-01
- 2 2.72607E-02 -9.27268E-02
- 3 -1.16746E-01 -1.38573E-01
- 4 -1.98630E-02 4.29344E-02
- 5 -9.92753E-02 -4.00815E-02
- 6 -2.44434E-02 -3.91092E-02
-6 0 *********** SCCS-ala-ile
- 1 -6.08164E-01 3.76219E-01
- 2 1.74606E-02 -7.01888E-02
- 3 4.21442E-03 -9.67046E-02
- 4 -9.16231E-02 1.20748E-01
- 5 -2.44847E-02 -6.78150E-02
- 6 -4.86552E-02 -1.03992E-01
-6 0 *********** SCCS-ala-leu
- 1 -4.32857E-01 4.54080E-01
- 2 2.22152E-02 -1.21616E-01
- 3 -4.29410E-02 -2.08721E-01
- 4 -5.58708E-02 8.85364E-02
- 5 -5.47986E-02 -6.79193E-02
- 6 -5.44840E-02 -1.10560E-01
-6 0 *********** SCCS-ala-val
- 1 -5.46652E-01 3.94687E-01
- 2 1.06558E-01 -1.02644E-01
- 3 -3.68364E-02 -5.06559E-02
- 4 -3.30635E-02 7.43897E-02
- 5 -1.31426E-01 -6.20887E-02
- 6 9.28900E-03 -2.88931E-02
-6 0 *********** SCCS-ala-trp
- 1 -5.12889E-01 3.54971E-01
- 2 2.48557E-02 5.68926E-03
- 3 -9.38995E-02 -1.25738E-01
- 4 -4.19572E-02 6.46048E-02
- 5 -6.07452E-02 -3.84727E-02
- 6 -3.95298E-02 -8.31586E-02
-6 0 *********** SCCS-ala-tyr
- 1 -4.04256E-01 3.91007E-01
- 2 1.03781E-02 -8.08145E-02
- 3 -1.39132E-01 -1.27036E-01
- 4 -1.29804E-03 4.31630E-02
- 5 -1.16617E-01 -3.22136E-02
- 6 -9.75651E-03 -2.83841E-02
-6 0 *********** SCCS-ala-ala
- 1 -6.12231E-01 1.94524E-01
- 2 1.94660E-01 3.30749E-02
- 3 5.97129E-02 -9.01564E-02
- 4 -8.13668E-02 8.68830E-02
- 5 -1.74542E-03 -2.80352E-02
- 6 -2.09383E-02 -1.06421E-01
-6 0 *********** SCCS-ala-gly
+4 0 *********** SCCS-tyr-thr
+ 1 4.43129E-01 -9.98765E-02
+ 2 2.04282E-02 -2.00306E-01
+ 3 -1.05974E-01 1.38295E-02
+ 4 -3.15679E-02 -3.11278E-02
+4 0 *********** SCCS-tyr-ser
+ 1 6.66665E-01 9.58879E-02
+ 2 3.34355E-01 -9.54379E-02
+ 3 -6.17057E-02 -1.52488E-01
+ 4 7.72154E-02 8.43553E-02
+4 0 *********** SCCS-tyr-gln
+ 1 4.37842E-01 -9.39496E-02
+ 2 4.04782E-02 -1.67628E-01
+ 3 -8.25634E-02 4.71052E-02
+ 4 -3.65037E-02 -1.97291E-02
+4 0 *********** SCCS-tyr-asn
+ 1 5.40093E-01 1.60657E-01
+ 2 2.63253E-01 -4.26824E-02
+ 3 2.73246E-02 -1.10022E-01
+ 4 -2.02731E-03 1.83667E-02
+4 0 *********** SCCS-tyr-glu
+ 1 4.65578E-01 -1.46079E-01
+ 2 7.61706E-03 -1.97810E-01
+ 3 -8.75500E-02 7.24762E-02
+ 4 -3.60083E-02 -1.46126E-02
+4 0 *********** SCCS-tyr-asp
+ 1 5.67738E-01 1.62877E-01
+ 2 2.87863E-01 -4.37540E-02
+ 3 3.52221E-02 -1.23523E-01
+ 4 2.01681E-02 2.44886E-02
+4 0 *********** SCCS-tyr-his
+ 1 4.92109E-01 1.70168E-01
+ 2 2.45441E-01 -1.63849E-02
+ 3 4.64559E-02 -1.29182E-01
+ 4 3.45022E-03 3.48007E-02
+4 0 *********** SCCS-tyr-arg
+ 1 3.14126E-01 -1.95475E-01
+ 2 -9.23748E-02 -1.38555E-01
+ 3 -4.03817E-02 6.17459E-02
+ 4 -3.32932E-02 9.17303E-03
+4 0 *********** SCCS-tyr-lys
+ 1 2.93079E-01 -1.90224E-01
+ 2 -1.01976E-01 -1.53648E-01
+ 3 -2.88171E-02 5.03449E-02
+ 4 -3.86407E-02 -5.83875E-03
+4 0 *********** SCCS-tyr-pro
+ 1 4.64556E-01 1.05697E-01
+ 2 3.36517E-01 -1.50630E-01
+ 3 -1.30342E-01 -1.88491E-01
+ 4 1.93320E-01 1.93493E-02
+4 0 *********** SCCS-ala-cys
+ 1 5.17504E-01 -1.15621E-01
+ 2 -2.78017E-01 -2.46450E-01
+ 3 1.43228E-01 -1.13635E-01
+ 4 1.81971E-02 -2.19186E-02
+4 0 *********** SCCS-ala-met
+ 1 3.06790E-01 -2.72879E-01
+ 2 -2.12822E-01 1.36660E-01
+ 3 -1.64592E-02 -3.59792E-02
+ 4 1.19042E-02 -4.00863E-02
+4 0 *********** SCCS-ala-phe
+ 1 2.93504E-01 -2.78677E-01
+ 2 -1.14338E-01 2.49323E-01
+ 3 -9.15688E-02 -4.35241E-02
+ 4 -2.99342E-02 -2.97687E-02
+4 0 *********** SCCS-ala-ile
+ 1 3.81000E-01 -3.38357E-01
+ 2 -2.69790E-01 1.13978E-01
+ 3 2.20053E-02 -1.06324E-01
+ 4 1.26719E-02 -2.72123E-02
+4 0 *********** SCCS-ala-leu
+ 1 1.87817E-01 -3.83373E-01
+ 2 -2.22169E-01 3.72273E-01
+ 3 -8.10128E-02 -3.27082E-02
+ 4 -6.54640E-04 -6.42731E-02
+4 0 *********** SCCS-ala-val
+ 1 3.29822E-01 -3.04273E-01
+ 2 -3.06624E-01 1.83651E-01
+ 3 -4.32460E-02 -7.25547E-02
+ 4 1.49068E-02 -4.24229E-02
+4 0 *********** SCCS-ala-trp
+ 1 3.24766E-01 -3.31163E-01
+ 2 -1.12692E-01 1.42964E-01
+ 3 -4.08045E-02 -7.47186E-02
+ 4 -2.22856E-02 -3.33097E-02
+4 0 *********** SCCS-ala-tyr
+ 1 2.94138E-01 -2.67378E-01
+ 2 -1.02416E-01 2.54456E-01
+ 3 -7.49459E-02 -2.60298E-02
+ 4 -2.32349E-02 -2.79041E-02
+4 0 *********** SCCS-ala-ala
+ 1 2.78430E-01 -2.18986E-01
+ 2 -4.25143E-01 6.83946E-02
+ 3 8.41961E-02 -3.15499E-02
+ 4 9.37586E-02 5.84512E-03
+4 0 *********** SCCS-ala-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-ala-thr
- 1 -6.80244E-01 2.82399E-01
- 2 1.46140E-01 -1.24080E-01
- 3 -4.28436E-02 1.04690E-02
- 4 -3.79855E-02 4.22225E-02
- 5 -6.83102E-02 -3.97209E-02
- 6 -1.17089E-02 3.21642E-02
-6 0 *********** SCCS-ala-ser
- 1 -1.25828E+00 1.98709E-02
- 2 5.75643E-01 2.72897E-01
- 3 -2.06187E-01 1.42949E-02
- 4 9.61208E-03 6.90565E-02
- 5 -1.24158E-01 2.54657E-02
- 6 -1.76551E-02 -1.00876E-01
-6 0 *********** SCCS-ala-gln
- 1 -6.67556E-01 2.35138E-01
- 2 1.53103E-01 5.32959E-02
- 3 -4.69499E-02 -8.98371E-02
- 4 -3.23213E-02 8.59389E-02
- 5 -5.31865E-02 -3.29743E-02
- 6 -3.24962E-02 -1.10470E-01
-6 0 *********** SCCS-ala-asn
- 1 -8.82213E-01 -1.96353E-01
- 2 1.61854E-01 4.02598E-01
- 3 -1.74884E-01 4.24055E-02
- 4 -3.24830E-02 9.41099E-02
- 5 -7.58262E-02 -3.80648E-02
- 6 -5.64397E-02 -2.40526E-01
-6 0 *********** SCCS-ala-glu
- 1 -6.94975E-01 3.25872E-01
- 2 1.54176E-01 -2.10567E-02
- 3 -1.44469E-02 -9.91634E-02
- 4 -2.64213E-02 9.63849E-02
- 5 -5.95332E-02 -3.34288E-02
- 6 -3.12275E-02 -8.37471E-02
-6 0 *********** SCCS-ala-asp
- 1 -9.42341E-01 -1.72029E-01
- 2 2.35718E-01 3.36372E-01
- 3 -1.53346E-01 9.23925E-02
- 4 1.21705E-02 4.39880E-02
- 5 -1.46440E-01 3.00360E-02
- 6 8.63453E-03 -1.02406E-01
-6 0 *********** SCCS-ala-his
- 1 -8.49054E-01 -1.04507E-01
- 2 1.56506E-01 3.05873E-01
- 3 -1.70738E-01 4.72288E-02
- 4 -9.09632E-02 1.19454E-01
- 5 -4.07039E-02 -3.00495E-02
- 6 -7.80062E-02 -2.11413E-01
-6 0 *********** SCCS-ala-arg
- 1 -3.93547E-01 3.43901E-01
- 2 3.30017E-02 -6.15635E-02
- 3 -8.65490E-02 -1.22140E-01
- 4 -1.24218E-02 5.69747E-02
- 5 -9.40418E-02 -3.31139E-02
- 6 -2.36903E-02 -4.90555E-02
-6 0 *********** SCCS-ala-lys
- 1 -4.43823E-01 3.59670E-01
- 2 1.59415E-02 -4.10491E-02
- 3 -3.10706E-02 -1.44413E-01
- 4 -4.48412E-02 9.07903E-02
- 5 -3.18838E-02 -4.91322E-02
- 6 -4.14286E-02 -1.02421E-01
-6 0 *********** SCCS-ala-pro
- 1 5.92441E-01 4.23394E-01
- 2 -4.48057E-02 1.16083E+00
- 3 -1.49893E-01 -5.59499E-02
- 4 -6.45567E-02 4.79780E-01
- 5 4.50455E-01 -1.92333E-01
- 6 -1.65095E-01 -8.22323E-01
-6 0 *********** SCCS-gly-cys
+4 0 *********** SCCS-ala-thr
+ 1 3.77641E-01 -3.13359E-01
+ 2 -2.80922E-01 8.72298E-02
+ 3 1.50802E-02 -9.86901E-02
+ 4 2.88410E-02 -1.46565E-02
+4 0 *********** SCCS-ala-ser
+ 1 5.72896E-01 3.51691E-02
+ 2 -2.61807E-01 -5.26417E-01
+ 3 2.19606E-01 -1.44148E-01
+ 4 1.22317E-02 -1.52747E-02
+4 0 *********** SCCS-ala-gln
+ 1 4.05550E-01 -2.85079E-01
+ 2 -2.55923E-01 7.39632E-03
+ 3 -2.48059E-02 -1.37493E-01
+ 4 9.74316E-03 -2.67603E-02
+4 0 *********** SCCS-ala-asn
+ 1 6.23989E-01 -4.68698E-02
+ 2 -6.72975E-02 -4.10474E-01
+ 3 1.87023E-01 -2.95986E-02
+ 4 1.45295E-02 -1.66240E-02
+4 0 *********** SCCS-ala-glu
+ 1 3.99331E-01 -3.34843E-01
+ 2 -2.83988E-01 6.59348E-02
+ 3 -4.72190E-02 -1.51632E-01
+ 4 -3.86735E-03 -2.22313E-02
+4 0 *********** SCCS-ala-asp
+ 1 6.61667E-01 -5.40240E-02
+ 2 -7.71390E-02 -4.21717E-01
+ 3 1.95768E-01 -2.74466E-02
+ 4 1.34416E-02 3.71095E-03
+4 0 *********** SCCS-ala-his
+ 1 6.48420E-01 -4.93751E-02
+ 2 2.18602E-02 -3.27254E-01
+ 3 2.02531E-01 9.70109E-02
+ 4 4.05286E-03 2.16230E-02
+4 0 *********** SCCS-ala-arg
+ 1 2.38360E-01 -3.17928E-01
+ 2 -1.17734E-01 2.35691E-01
+ 3 -3.31488E-02 -2.26556E-02
+ 4 -9.22722E-03 -1.22751E-02
+4 0 *********** SCCS-ala-lys
+ 1 1.90188E-01 -3.46793E-01
+ 2 -1.72410E-01 2.76499E-01
+ 3 -3.79097E-02 1.47776E-02
+ 4 3.59765E-03 -3.93860E-02
+4 0 *********** SCCS-ala-pro
+ 1 7.05480E-01 -1.44827E-01
+ 2 -1.13182E-01 -2.87785E-01
+ 3 4.06266E-01 -2.54091E-01
+ 4 4.58362E-02 -2.52399E-02
+4 0 *********** SCCS-gly-cys
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-met
+4 0 *********** SCCS-gly-met
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-phe
+4 0 *********** SCCS-gly-phe
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-ile
+4 0 *********** SCCS-gly-ile
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-leu
+4 0 *********** SCCS-gly-leu
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-val
+4 0 *********** SCCS-gly-val
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-trp
+4 0 *********** SCCS-gly-trp
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-tyr
+4 0 *********** SCCS-gly-tyr
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-ala
+4 0 *********** SCCS-gly-ala
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-gly
+4 0 *********** SCCS-gly-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-thr
+4 0 *********** SCCS-gly-thr
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-ser
+4 0 *********** SCCS-gly-ser
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-gln
+4 0 *********** SCCS-gly-gln
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-asn
+4 0 *********** SCCS-gly-asn
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-glu
+4 0 *********** SCCS-gly-glu
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-asp
+4 0 *********** SCCS-gly-asp
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-his
+4 0 *********** SCCS-gly-his
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-arg
+4 0 *********** SCCS-gly-arg
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-lys
+4 0 *********** SCCS-gly-lys
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gly-pro
+4 0 *********** SCCS-gly-pro
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-thr-cys
- 1 -4.78252E-01 -1.21282E+00
- 2 2.30200E-01 -1.93371E-01
- 3 -2.62189E-01 -1.34267E-02
- 4 1.20677E-01 -5.43489E-02
- 5 -2.28955E-01 -2.49593E-02
- 6 3.45747E-02 -1.30880E-01
-6 0 *********** SCCS-thr-met
- 1 -4.76883E-01 -6.89293E-01
- 2 -1.13823E-01 -2.94833E-01
- 3 -1.70193E-01 -1.86699E-02
- 4 -1.10863E-02 4.45008E-02
- 5 -1.15430E-01 -6.80059E-02
- 6 -3.24995E-02 -1.17920E-01
-6 0 *********** SCCS-thr-phe
- 1 -5.50351E-01 -7.12325E-01
- 2 -3.23486E-01 -1.53650E-01
- 3 -1.34118E-01 -8.39328E-02
- 4 -7.59681E-02 9.41809E-02
- 5 -3.47416E-02 -9.43178E-02
- 6 -7.94893E-02 -2.51501E-01
-6 0 *********** SCCS-thr-ile
- 1 -4.74101E-01 -9.61700E-01
- 2 -1.96021E-01 -3.37099E-01
- 3 -3.04114E-01 1.15258E-01
- 4 5.99404E-02 4.48290E-02
- 5 -1.65781E-01 -4.79378E-02
- 6 2.44909E-03 -5.78368E-02
-6 0 *********** SCCS-thr-leu
- 1 -5.18402E-01 -4.57179E-01
- 2 -3.35443E-01 -4.02755E-01
- 3 -1.64278E-01 -1.10675E-01
- 4 -3.93933E-02 9.99274E-02
- 5 -1.12048E-01 -8.64722E-02
- 6 -2.20778E-02 -1.39755E-01
-6 0 *********** SCCS-thr-val
- 1 -5.36201E-01 -6.61594E-01
- 2 -1.90235E-01 -4.54193E-01
- 3 -1.73250E-01 -3.63807E-02
- 4 -1.54668E-01 1.71872E-01
- 5 5.10418E-02 -1.16297E-01
- 6 -9.69115E-02 -1.95628E-01
-6 0 *********** SCCS-thr-trp
- 1 -6.10855E-01 -7.62383E-01
- 2 -8.03668E-02 -1.22626E-01
- 3 -1.52481E-01 -6.08235E-02
- 4 -2.03662E-02 1.60383E-02
- 5 -1.19499E-01 -3.98874E-02
- 6 -3.06429E-02 -1.67410E-01
-6 0 *********** SCCS-thr-tyr
- 1 -5.82783E-01 -7.01074E-01
- 2 -2.87141E-01 -7.06469E-02
- 3 -1.60396E-01 -5.44901E-02
- 4 2.09835E-02 3.01896E-02
- 5 -1.25293E-01 -4.31272E-02
- 6 -4.37682E-02 -1.81502E-01
-6 0 *********** SCCS-thr-ala
- 1 -4.57130E-01 -4.24338E-01
- 2 1.40275E-01 -5.64149E-01
- 3 -2.64578E-01 -3.40173E-02
- 4 6.40720E-02 7.40211E-02
- 5 -2.67262E-01 -1.30189E-02
- 6 7.00275E-02 3.47947E-02
-6 0 *********** SCCS-thr-gly
+4 0 *********** SCCS-thr-cys
+ 1 6.94146E-01 -1.10554E-01
+ 2 -3.15401E-01 -2.43730E-01
+ 3 8.32213E-02 -7.15149E-02
+ 4 5.66906E-02 8.41925E-03
+4 0 *********** SCCS-thr-met
+ 1 4.32580E-01 -2.39169E-01
+ 2 -2.56341E-01 1.56166E-01
+ 3 -5.16709E-03 4.76564E-02
+ 4 1.03130E-02 -4.42845E-02
+4 0 *********** SCCS-thr-phe
+ 1 4.15597E-01 -2.72196E-01
+ 2 -1.51395E-01 2.99282E-01
+ 3 -4.50011E-02 3.19434E-02
+ 4 -3.07748E-02 -1.79729E-02
+4 0 *********** SCCS-thr-ile
+ 1 5.39174E-01 -2.24077E-01
+ 2 -3.27413E-01 7.71185E-02
+ 3 -4.86396E-02 2.77815E-02
+ 4 4.52735E-02 -5.11917E-02
+4 0 *********** SCCS-thr-leu
+ 1 3.27056E-01 -3.30255E-01
+ 2 -2.49986E-01 4.43994E-01
+ 3 -6.32695E-03 5.11674E-02
+ 4 -6.20378E-02 -8.73174E-02
+4 0 *********** SCCS-thr-val
+ 1 4.58099E-01 -3.02824E-01
+ 2 -4.19837E-01 2.14224E-01
+ 3 -3.97065E-02 2.92216E-02
+ 4 -7.84974E-03 -8.54191E-02
+4 0 *********** SCCS-thr-trp
+ 1 4.78223E-01 -2.54797E-01
+ 2 -1.58174E-01 1.26678E-01
+ 3 -1.92522E-02 2.16408E-02
+ 4 -8.29943E-03 -3.27046E-02
+4 0 *********** SCCS-thr-tyr
+ 1 4.16175E-01 -2.63677E-01
+ 2 -1.04597E-01 2.78809E-01
+ 3 -4.67057E-02 2.51712E-02
+ 4 -2.98319E-02 -1.77672E-02
+4 0 *********** SCCS-thr-ala
+ 1 3.50298E-01 -1.15334E-01
+ 2 -5.12625E-01 1.63761E-01
+ 3 1.85377E-02 4.73053E-02
+ 4 1.02115E-01 -8.55357E-02
+4 0 *********** SCCS-thr-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-thr-thr
- 1 -4.00198E-01 -8.37045E-01
- 2 1.31558E-01 -3.11476E-01
- 3 -2.82928E-01 -3.09156E-01
- 4 -2.91050E-01 2.16151E-01
- 5 1.62207E-01 -1.29139E-01
- 6 -1.99401E-01 -4.43480E-01
-6 0 *********** SCCS-thr-ser
- 1 -6.91653E-01 -1.77025E+00
- 2 3.19225E-01 -1.53412E-01
- 3 -2.40168E-01 -2.27141E-01
- 4 -3.10878E-03 -4.34126E-03
- 5 -1.16980E-01 -1.02597E-01
- 6 -6.51546E-02 -4.38794E-01
-6 0 *********** SCCS-thr-gln
- 1 -5.78616E-01 -8.24726E-01
- 2 7.23174E-02 -1.74898E-01
- 3 -1.25154E-01 -6.13718E-02
- 4 4.23225E-03 -4.72411E-03
- 5 -1.15575E-01 -5.90561E-02
- 6 -3.22209E-02 -1.59844E-01
-6 0 *********** SCCS-thr-asn
- 1 -2.97795E-01 -1.12293E+00
- 2 3.80284E-01 -2.41235E-03
- 3 -1.60209E-01 -8.45606E-02
- 4 1.20696E-01 -5.27442E-02
- 5 -1.94928E-01 -4.42491E-02
- 6 1.81182E-02 -2.21766E-01
-6 0 *********** SCCS-thr-glu
- 1 -6.60150E-01 -8.99749E-01
- 2 1.54939E-02 -2.39422E-01
- 3 -1.50985E-01 -4.71386E-02
- 4 -8.99812E-03 -1.89234E-02
- 5 -1.30256E-01 -6.21209E-02
- 6 -3.54086E-02 -1.41274E-01
-6 0 *********** SCCS-thr-asp
- 1 -8.28763E-02 -9.70862E-01
- 2 5.16883E-01 -3.22882E-01
- 3 -2.81189E-01 -8.89955E-02
- 4 1.40981E-01 -5.01782E-02
- 5 -2.33595E-01 -2.02784E-02
- 6 5.54853E-02 -8.22412E-02
-6 0 *********** SCCS-thr-his
- 1 -3.98116E-01 -1.34384E+00
- 2 1.69249E-01 6.75837E-02
- 3 -1.88083E-01 -5.60535E-02
- 4 4.69898E-02 -2.90069E-03
- 5 -7.39476E-02 1.33782E-02
- 6 -7.93948E-02 -2.65030E-01
-6 0 *********** SCCS-thr-arg
- 1 -5.42741E-01 -5.01279E-01
- 2 -1.88557E-01 -2.04413E-01
- 3 -1.30541E-01 -1.04576E-01
- 4 -8.71559E-02 1.17049E-01
- 5 -3.46579E-02 -8.81523E-02
- 6 -7.37831E-02 -2.24380E-01
-6 0 *********** SCCS-thr-lys
- 1 -4.78204E-01 -5.06985E-01
- 2 -2.06269E-01 -3.50811E-01
- 3 -1.55467E-01 -5.96862E-02
- 4 7.58353E-03 1.00290E-01
- 5 -1.32738E-01 -4.69953E-02
- 6 -2.22697E-02 -1.07470E-01
-6 0 *********** SCCS-thr-pro
- 1 -1.67495E+00 1.99389E+00
- 2 4.18464E-01 2.38030E+00
- 3 -1.02443E+00 3.98025E-01
- 4 -2.77855E-01 5.99878E-01
- 5 -8.59721E-01 3.47303E-01
- 6 -3.80802E-01 -3.84736E-01
-6 0 *********** SCCS-ser-cys
- 1 -6.75936E-01 -2.51372E-01
- 2 2.83749E-01 2.22765E-02
- 3 -8.37611E-02 -2.98347E-02
- 4 -1.25832E-02 2.82799E-02
- 5 -4.89796E-02 -1.31941E-02
- 6 -2.04676E-02 -9.34153E-02
-6 0 *********** SCCS-ser-met
- 1 -4.79277E-01 -5.85533E-02
- 2 4.67438E-02 -9.61475E-02
- 3 -7.78201E-02 -1.10824E-01
- 4 -3.68149E-02 4.88099E-02
- 5 -8.43379E-02 -4.71735E-02
- 6 -3.11575E-02 -1.05951E-01
-6 0 *********** SCCS-ser-phe
- 1 -4.40817E-01 -1.93201E-03
- 2 -3.75256E-02 -4.70413E-02
- 3 -1.11120E-01 -2.00006E-01
- 4 -1.03561E-01 8.27181E-02
- 5 -3.10534E-02 -5.29796E-02
- 6 -7.45012E-02 -1.88387E-01
-6 0 *********** SCCS-ser-ile
- 1 -4.89129E-01 -9.71660E-02
- 2 6.96478E-02 -9.84504E-02
- 3 -9.78677E-02 -6.23724E-02
- 4 -4.38765E-02 4.39530E-02
- 5 -7.58677E-02 -4.90286E-02
- 6 -3.04404E-02 -8.35285E-02
-6 0 *********** SCCS-ser-leu
- 1 -4.61498E-01 5.70563E-02
- 2 -5.70577E-02 -1.52749E-01
- 3 -8.29277E-02 -1.86562E-01
- 4 -1.35198E-03 6.69431E-02
- 5 -1.25108E-01 -2.25713E-02
- 6 -3.30351E-02 -9.94868E-02
-6 0 *********** SCCS-ser-val
- 1 -4.91643E-01 -5.75777E-03
- 2 1.56976E-02 -1.20510E-01
- 3 -6.39172E-02 -1.37088E-01
- 4 -8.35079E-02 7.43083E-02
- 5 -2.99272E-02 -3.25470E-02
- 6 -7.48698E-02 -1.03754E-01
-6 0 *********** SCCS-ser-trp
- 1 -4.90971E-01 -7.66287E-02
- 2 7.58249E-02 -6.22292E-02
- 3 -1.49855E-01 -9.47067E-02
- 4 1.49302E-02 2.48190E-02
- 5 -1.45208E-01 -2.49698E-02
- 6 -4.35175E-04 -8.53366E-02
-6 0 *********** SCCS-ser-tyr
- 1 -4.17677E-01 2.35700E-03
- 2 -4.83259E-02 -4.16898E-02
- 3 -1.25891E-01 -1.79935E-01
- 4 -7.78872E-02 9.52749E-02
- 5 -3.47220E-02 -5.12502E-02
- 6 -7.29019E-02 -1.81669E-01
-6 0 *********** SCCS-ser-ala
- 1 -5.17095E-01 -7.94432E-02
- 2 1.72920E-01 -1.53668E-01
- 3 -9.76482E-02 4.32460E-02
- 4 9.89786E-02 3.44415E-02
- 5 -1.85130E-01 -4.41722E-02
- 6 5.61277E-02 -1.20588E-02
-6 0 *********** SCCS-ser-gly
+4 0 *********** SCCS-thr-thr
+ 1 5.32639E-01 -2.51788E-01
+ 2 -3.65678E-01 2.80268E-02
+ 3 -8.20267E-02 3.41941E-02
+ 4 3.20060E-02 -3.66002E-02
+4 0 *********** SCCS-thr-ser
+ 1 8.29226E-01 -4.47256E-02
+ 2 -3.07794E-01 -5.43561E-01
+ 3 1.52434E-01 -1.70668E-01
+ 4 4.02455E-02 2.94916E-02
+4 0 *********** SCCS-thr-gln
+ 1 5.44618E-01 -2.61200E-01
+ 2 -2.91685E-01 -8.52894E-04
+ 3 -6.22562E-02 -3.13102E-02
+ 4 7.05645E-03 -3.96955E-02
+4 0 *********** SCCS-thr-asn
+ 1 7.29074E-01 1.96296E-02
+ 2 -1.83089E-01 -4.48830E-01
+ 3 8.45099E-02 -7.55621E-02
+ 4 1.42241E-02 2.85328E-02
+4 0 *********** SCCS-thr-glu
+ 1 5.55177E-01 -3.20515E-01
+ 2 -3.35056E-01 6.64964E-02
+ 3 -8.15214E-02 -1.60734E-02
+ 4 -5.10384E-03 -6.58212E-02
+4 0 *********** SCCS-thr-asp
+ 1 7.77903E-01 1.48359E-02
+ 2 -1.81561E-01 -4.55763E-01
+ 3 8.06929E-02 -8.81991E-02
+ 4 2.74675E-02 2.53221E-02
+4 0 *********** SCCS-thr-his
+ 1 7.18127E-01 5.33399E-02
+ 2 -5.18661E-02 -3.85563E-01
+ 3 1.00852E-01 -1.09336E-03
+ 4 9.59055E-03 3.86896E-02
+4 0 *********** SCCS-thr-arg
+ 1 3.55433E-01 -3.15600E-01
+ 2 -1.53066E-01 2.59433E-01
+ 3 1.89246E-03 4.45031E-02
+ 4 -2.07639E-02 -2.58293E-02
+4 0 *********** SCCS-thr-lys
+ 1 3.15369E-01 -3.08440E-01
+ 2 -2.15935E-01 3.06506E-01
+ 3 9.15967E-03 7.76526E-02
+ 4 -2.41978E-02 -4.64169E-02
+4 0 *********** SCCS-thr-pro
+ 1 8.64041E-01 -3.46195E-02
+ 2 -2.43266E-01 -5.75809E-01
+ 3 9.44992E-02 -3.26994E-01
+ 4 4.31977E-02 -2.28477E-02
+4 0 *********** SCCS-ser-cys
+ 1 1.12657E+00 -4.05912E-01
+ 2 -2.04372E-01 2.21214E-01
+ 3 1.94762E-01 -2.38945E-02
+ 4 2.72424E-02 -1.36295E-01
+4 0 *********** SCCS-ser-met
+ 1 5.52897E-01 -5.23767E-01
+ 2 1.93424E-01 3.78624E-01
+ 3 1.58880E-01 -8.44168E-02
+ 4 -2.30319E-02 -3.90520E-02
+4 0 *********** SCCS-ser-phe
+ 1 6.07247E-01 -6.37768E-01
+ 2 4.84383E-01 1.21296E-01
+ 3 -5.03608E-04 -1.46678E-01
+ 4 -7.88804E-02 -4.13110E-03
+4 0 *********** SCCS-ser-ile
+ 1 8.28835E-01 -6.04995E-01
+ 2 3.10932E-01 5.50024E-01
+ 3 2.93309E-01 -1.09850E-01
+ 4 1.53895E-02 -2.36185E-02
+4 0 *********** SCCS-ser-leu
+ 1 2.18535E-01 -6.37048E-01
+ 2 6.23176E-01 5.76774E-01
+ 3 1.30993E-01 -1.16495E-01
+ 4 -1.08630E-02 6.41354E-02
+4 0 *********** SCCS-ser-val
+ 1 6.94161E-01 -5.64087E-01
+ 2 3.62179E-01 6.66479E-01
+ 3 2.67300E-01 -1.35004E-01
+ 4 -1.23872E-03 2.69694E-02
+4 0 *********** SCCS-ser-trp
+ 1 6.83990E-01 -6.22528E-01
+ 2 2.18412E-01 2.10656E-01
+ 3 4.96465E-02 -1.90013E-01
+ 4 -5.13491E-02 -1.09238E-02
+4 0 *********** SCCS-ser-tyr
+ 1 5.94121E-01 -6.45033E-01
+ 2 4.43614E-01 6.71824E-02
+ 3 -5.00495E-03 -1.30727E-01
+ 4 -7.13470E-02 -2.88808E-03
+4 0 *********** SCCS-ser-ala
+ 1 2.91750E-01 -4.88415E-01
+ 2 -9.19135E-02 8.74485E-01
+ 3 2.11077E-01 3.74125E-02
+ 4 -4.78129E-02 -3.48121E-02
+4 0 *********** SCCS-ser-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-ser-thr
- 1 -4.78359E-01 -1.05343E-01
- 2 1.25776E-01 -1.06119E-01
- 3 -1.18951E-01 -8.34825E-02
- 4 -5.75417E-02 6.94834E-02
- 5 -7.02717E-02 -6.29224E-02
- 6 -3.55264E-02 -1.23105E-01
-6 0 *********** SCCS-ser-ser
- 1 -9.33073E-01 -3.08202E-01
- 2 4.33602E-01 1.17228E-01
- 3 -3.07553E-02 -1.72160E-01
- 4 -1.47558E-01 1.50928E-01
- 5 1.90943E-01 -9.29047E-02
- 6 -1.44184E-01 -3.58001E-01
-6 0 *********** SCCS-ser-gln
- 1 -5.59586E-01 -1.28952E-01
- 2 1.44841E-01 -5.37194E-02
- 3 -7.17698E-02 -8.96105E-02
- 4 -4.40377E-02 4.77416E-02
- 5 -4.85355E-02 -4.67083E-02
- 6 -3.69193E-02 -1.24130E-01
-6 0 *********** SCCS-ser-asn
- 1 -6.51055E-01 -4.39756E-01
- 2 2.48476E-01 1.53902E-01
- 3 -1.80528E-01 -1.23069E-02
- 4 -4.77216E-02 9.02530E-02
- 5 -6.22917E-02 2.54240E-03
- 6 -3.74477E-02 -1.92629E-01
-6 0 *********** SCCS-ser-glu
- 1 -5.91225E-01 -8.29610E-02
- 2 1.36775E-01 -1.06866E-01
- 3 -5.84922E-02 -8.64410E-02
- 4 -5.33579E-02 5.12381E-02
- 5 -5.25020E-02 -5.63398E-02
- 6 -3.31115E-02 -1.06697E-01
-6 0 *********** SCCS-ser-asp
- 1 -5.91005E-01 -3.74842E-01
- 2 2.42275E-01 9.30429E-02
- 3 -1.71360E-01 3.33390E-02
- 4 8.66703E-04 7.33567E-02
- 5 -3.62694E-02 -2.52558E-02
- 6 -6.07643E-02 -1.46528E-01
-6 0 *********** SCCS-ser-his
- 1 -5.31584E-01 -4.23968E-01
- 2 1.78112E-01 2.18263E-01
- 3 -1.91242E-01 -4.86434E-02
- 4 -5.74705E-02 9.23880E-02
- 5 -6.57485E-02 -6.23534E-02
- 6 -8.41895E-03 -2.86348E-01
-6 0 *********** SCCS-ser-arg
- 1 -4.25794E-01 7.53531E-03
- 2 -1.30989E-02 -8.86256E-02
- 3 -1.18246E-01 -1.16565E-01
- 4 -5.29254E-02 7.23512E-02
- 5 -8.41741E-02 -4.71509E-02
- 6 -2.76868E-02 -1.18162E-01
-6 0 *********** SCCS-ser-lys
- 1 -4.33240E-01 -6.29186E-03
- 2 -1.43180E-02 -1.22178E-01
- 3 -9.51192E-02 -1.23200E-01
- 4 -2.80523E-02 5.77444E-02
- 5 -1.14024E-01 -4.81200E-02
- 6 -1.53999E-02 -1.03247E-01
-6 0 *********** SCCS-ser-pro
- 1 3.70161E-01 5.65740E-01
- 2 1.05712E-01 1.04689E+00
- 3 -1.78745E-02 6.36354E-01
- 4 -2.03219E-01 4.43976E-01
- 5 -6.52191E-01 4.55377E-01
- 6 -3.06751E-01 1.59676E-01
-6 0 *********** SCCS-gln-cys
- 1 -3.78657E-01 -1.03174E+00
- 2 2.99986E-01 -6.08579E-02
- 3 -1.74084E-01 -1.86924E-02
- 4 1.23712E-01 -2.59351E-02
- 5 -1.53103E-01 -3.48945E-02
- 6 2.49076E-02 -1.74405E-01
-6 0 *********** SCCS-gln-met
- 1 -3.97262E-01 -6.36989E-01
- 2 9.77800E-03 -3.10533E-01
- 3 -1.80090E-01 -5.82939E-02
- 4 -4.26313E-02 3.74287E-02
- 5 -8.73326E-02 -4.34022E-02
- 6 -3.23650E-02 -9.90856E-02
-6 0 *********** SCCS-gln-phe
- 1 -4.47849E-01 -6.47983E-01
- 2 -2.06546E-01 -2.38765E-01
- 3 -1.45039E-01 -1.45211E-01
- 4 -1.32275E-01 9.73647E-02
- 5 -7.25739E-03 -8.60319E-02
- 6 -1.00530E-01 -2.43895E-01
-6 0 *********** SCCS-gln-ile
- 1 -3.59745E-01 -8.06123E-01
- 2 -8.35108E-03 -3.54256E-01
- 3 -2.93051E-01 1.63909E-03
- 4 -4.44899E-02 -5.23598E-04
- 5 -1.13093E-01 -1.87610E-02
- 6 -3.02316E-02 -2.87519E-02
-6 0 *********** SCCS-gln-leu
- 1 -4.69746E-01 -4.39820E-01
- 2 -1.67933E-01 -5.12800E-01
- 3 -1.73229E-01 -1.31450E-01
- 4 -3.43452E-02 8.76257E-02
- 5 -1.36679E-01 -4.84730E-02
- 6 4.40327E-03 -7.22009E-02
-6 0 *********** SCCS-gln-val
- 1 -5.15814E-01 -6.16676E-01
- 2 3.32873E-02 -4.13802E-01
- 3 -1.89944E-01 -1.70376E-01
- 4 -2.52293E-01 1.69662E-01
- 5 9.08513E-02 -2.66504E-02
- 6 -8.76044E-02 -1.89805E-01
-6 0 *********** SCCS-gln-trp
- 1 -4.83279E-01 -7.00803E-01
- 2 -1.36902E-02 -1.85220E-01
- 3 -1.67112E-01 -7.37444E-02
- 4 -9.19416E-03 2.43077E-02
- 5 -1.51276E-01 -4.24719E-02
- 6 -3.14920E-03 -1.48435E-01
-6 0 *********** SCCS-gln-tyr
- 1 -4.54834E-01 -6.35611E-01
- 2 -2.27888E-01 -1.90841E-01
- 3 -1.49858E-01 -1.01266E-01
- 4 -6.86815E-02 8.49749E-02
- 5 -5.92009E-02 -6.88625E-02
- 6 -6.06456E-02 -2.09833E-01
-6 0 *********** SCCS-gln-ala
- 1 -4.24436E-01 -4.20815E-01
- 2 3.31291E-01 -5.05157E-01
- 3 -2.44482E-01 -3.42572E-02
- 4 7.75718E-02 -1.00779E-02
- 5 -2.09211E-01 -2.94344E-02
- 6 7.16461E-02 5.52702E-02
-6 0 *********** SCCS-gln-gly
+4 0 *********** SCCS-ser-thr
+ 1 5.97190E-01 -6.25224E-01
+ 2 -1.05158E-01 6.42155E-01
+ 3 2.04056E-01 -1.68946E-02
+ 4 3.56706E-02 -1.42799E-02
+4 0 *********** SCCS-ser-ser
+ 1 1.52873E+00 -3.54863E-01
+ 2 -5.14291E-01 1.50261E-01
+ 3 7.43751E-02 -8.86048E-04
+ 4 1.34172E-01 -8.00352E-02
+4 0 *********** SCCS-ser-gln
+ 1 6.96482E-01 -6.02667E-01
+ 2 -8.72616E-02 2.77530E-01
+ 3 4.07313E-02 -1.34747E-01
+ 4 -4.71931E-02 -9.46027E-02
+4 0 *********** SCCS-ser-asn
+ 1 1.11561E+00 -4.15743E-01
+ 2 -4.64873E-01 3.47477E-02
+ 3 3.25972E-02 -4.08680E-02
+ 4 1.91945E-02 -9.03816E-02
+4 0 *********** SCCS-ser-glu
+ 1 7.64680E-01 -6.78554E-01
+ 2 3.96633E-03 3.30346E-01
+ 3 8.40013E-02 -1.30851E-01
+ 4 -4.91193E-02 -7.39387E-02
+4 0 *********** SCCS-ser-asp
+ 1 1.28950E+00 -4.72641E-01
+ 2 -4.47849E-01 8.30029E-02
+ 3 2.25887E-02 3.44555E-02
+ 4 1.69517E-02 -7.94096E-02
+4 0 *********** SCCS-ser-his
+ 1 1.13239E+00 -4.48872E-01
+ 2 -2.52264E-01 2.14956E-02
+ 3 2.19007E-01 4.35203E-02
+ 4 7.47493E-02 -1.98832E-02
+4 0 *********** SCCS-ser-arg
+ 1 3.96490E-01 -5.99399E-01
+ 2 3.73001E-01 3.41080E-01
+ 3 1.05579E-01 -1.31530E-01
+ 4 -1.00618E-02 -1.83315E-03
+4 0 *********** SCCS-ser-lys
+ 1 2.66381E-01 -5.72008E-01
+ 2 3.93176E-01 4.27667E-01
+ 3 1.60034E-01 -5.56215E-02
+ 4 -9.38006E-03 2.60630E-02
+4 0 *********** SCCS-ser-pro
+ 1 1.75239E+00 7.86060E-02
+ 2 -7.34679E-01 6.12669E-02
+ 3 2.08017E-01 -5.04840E-02
+ 4 2.47507E-01 -1.67663E-02
+4 0 *********** SCCS-gln-cys
+ 1 5.79299E-01 -3.92261E-01
+ 2 4.78812E-02 1.59890E-01
+ 3 -4.19228E-04 9.15860E-03
+ 4 2.19637E-02 -9.74747E-03
+4 0 *********** SCCS-gln-met
+ 1 2.60284E-01 -4.42096E-01
+ 2 1.67225E-01 3.36405E-02
+ 3 3.09445E-03 -2.56183E-02
+ 4 -1.06754E-02 -1.63804E-03
+4 0 *********** SCCS-gln-phe
+ 1 1.87631E-01 -4.95490E-01
+ 2 1.83229E-01 -8.94963E-02
+ 3 -1.27097E-02 -2.03116E-02
+ 4 7.76995E-03 2.45116E-02
+4 0 *********** SCCS-gln-ile
+ 1 3.92171E-01 -4.79698E-01
+ 2 1.78783E-01 6.83637E-02
+ 3 6.47875E-03 -2.62212E-02
+ 4 2.31055E-03 -1.54887E-02
+4 0 *********** SCCS-gln-leu
+ 1 1.14007E-01 -4.60150E-01
+ 2 2.53930E-01 -4.84242E-02
+ 3 2.46070E-02 -3.40276E-02
+ 4 -3.00650E-02 1.14012E-02
+4 0 *********** SCCS-gln-val
+ 1 2.92983E-01 -4.80541E-01
+ 2 2.40605E-01 8.05510E-02
+ 3 2.49547E-02 -2.96703E-02
+ 4 -3.41654E-02 -2.04849E-02
+4 0 *********** SCCS-gln-trp
+ 1 2.75555E-01 -4.97123E-01
+ 2 1.26874E-01 -5.73869E-03
+ 3 -1.05645E-02 -1.30748E-02
+ 4 -2.01834E-03 1.13898E-03
+4 0 *********** SCCS-gln-tyr
+ 1 1.74347E-01 -4.97323E-01
+ 2 1.50749E-01 -9.23285E-02
+ 3 -1.36964E-02 -1.53743E-02
+ 4 5.29976E-03 1.10334E-02
+4 0 *********** SCCS-gln-ala
+ 1 2.34424E-01 -3.04211E-01
+ 2 2.31434E-01 1.61410E-01
+ 3 2.96583E-02 1.55498E-02
+ 4 -1.84200E-02 -4.01721E-02
+4 0 *********** SCCS-gln-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-gln-thr
- 1 -3.03209E-01 -6.98179E-01
- 2 2.44917E-01 -3.04184E-01
- 3 -2.39339E-01 -2.87544E-01
- 4 -2.05542E-01 6.12287E-02
- 5 -6.70010E-03 -8.58810E-02
- 6 -1.29112E-01 -2.79558E-01
-6 0 *********** SCCS-gln-ser
- 1 -7.07382E-01 -1.36578E+00
- 2 4.93845E-01 1.99758E-01
- 3 -4.10441E-02 -2.36320E-01
- 4 1.19249E-02 6.98319E-02
- 5 3.41754E-02 -5.64061E-02
- 6 -2.46900E-02 -5.06199E-01
-6 0 *********** SCCS-gln-gln
- 1 -4.70075E-01 -7.61202E-01
- 2 1.59596E-01 -1.63292E-01
- 3 -1.32824E-01 -7.51517E-02
- 4 5.97928E-03 1.20702E-03
- 5 -1.02351E-01 -3.95062E-02
- 6 -1.44607E-02 -1.48045E-01
-6 0 *********** SCCS-gln-asn
- 1 -2.23034E-01 -1.00535E+00
- 2 3.68944E-01 1.29083E-01
- 3 -1.54627E-01 -4.01162E-03
- 4 1.77949E-01 -2.68915E-02
- 5 -1.97537E-01 -1.60013E-03
- 6 5.02450E-02 -1.99642E-01
-6 0 *********** SCCS-gln-glu
- 1 -5.43431E-01 -8.05564E-01
- 2 1.45278E-01 -2.51063E-01
- 3 -1.63713E-01 -7.71359E-02
- 4 -2.09429E-02 -7.85377E-03
- 5 -1.04595E-01 -3.89351E-02
- 6 -2.64487E-02 -1.15315E-01
-6 0 *********** SCCS-gln-asp
- 1 7.07679E-03 -8.17827E-01
- 2 4.97616E-01 -4.63663E-02
- 3 -1.74624E-01 2.28487E-02
- 4 1.08495E-01 -8.19002E-03
- 5 -1.27738E-01 1.20698E-03
- 6 2.23359E-02 -9.95721E-02
-6 0 *********** SCCS-gln-his
- 1 -2.52482E-01 -1.14883E+00
- 2 2.24564E-01 1.98816E-01
- 3 -1.85558E-01 2.05834E-04
- 4 4.91996E-02 8.60683E-03
- 5 -1.49607E-01 -2.46427E-02
- 6 -7.93116E-03 -2.87346E-01
-6 0 *********** SCCS-gln-arg
- 1 -4.72072E-01 -4.77430E-01
- 2 -8.78127E-02 -2.68670E-01
- 3 -1.55619E-01 -1.13500E-01
- 4 -8.92743E-02 8.81233E-02
- 5 -5.08411E-02 -5.91076E-02
- 6 -5.26929E-02 -1.59327E-01
-6 0 *********** SCCS-gln-lys
- 1 -4.20651E-01 -4.86376E-01
- 2 -5.74136E-02 -4.11034E-01
- 3 -1.81302E-01 -5.72312E-02
- 4 -4.94468E-02 7.51362E-02
- 5 -1.45406E-01 -6.40972E-02
- 6 9.89860E-03 -7.93734E-02
-6 0 *********** SCCS-gln-pro
- 1 -2.33433E+01 6.16546E-01
- 2 2.19328E+01 2.31249E+00
- 3 -2.26728E+01 5.13543E-01
- 4 2.19107E+01 -2.60800E-01
- 5 -2.31940E+01 5.68846E-01
- 6 1.12249E+01 2.13542E-01
-6 0 *********** SCCS-asn-cys
- 1 -3.81221E-01 -1.24183E+00
- 2 1.77744E-01 -2.24530E-01
- 3 -2.19645E-01 1.91884E-03
- 4 5.68149E-02 5.55250E-03
- 5 -9.88176E-02 -2.94638E-02
- 6 -5.76986E-03 -1.61760E-01
-6 0 *********** SCCS-asn-met
- 1 -4.14485E-01 -7.03590E-01
- 2 -5.65333E-02 -3.34035E-01
- 3 -1.65019E-01 -5.54883E-02
- 4 -6.62833E-02 6.43652E-02
- 5 -4.65185E-02 -7.25391E-02
- 6 -5.59685E-02 -1.37172E-01
-6 0 *********** SCCS-asn-phe
- 1 -4.88728E-01 -7.90689E-01
- 2 -2.41462E-01 -2.18277E-01
- 3 -1.27789E-01 -2.35880E-01
- 4 -1.13521E-01 1.33365E-01
- 5 5.46675E-02 -1.38110E-01
- 6 -1.27259E-01 -3.86126E-01
-6 0 *********** SCCS-asn-ile
- 1 -4.06873E-01 -9.20526E-01
- 2 -6.55001E-02 -3.69403E-01
- 3 -3.07097E-01 -7.27184E-02
- 4 -1.56268E-01 1.47582E-01
- 5 2.94983E-02 -1.14863E-02
- 6 -6.64692E-02 -1.83426E-01
-6 0 *********** SCCS-asn-leu
- 1 -4.56668E-01 -6.23593E-01
- 2 -1.82973E-01 -5.60058E-01
- 3 -2.55619E-01 -5.19992E-02
- 4 2.44867E-02 1.02573E-01
- 5 -2.37314E-01 -6.01161E-02
- 6 5.79650E-02 -6.83231E-02
-6 0 *********** SCCS-asn-val
- 1 -4.96020E-01 -7.68406E-01
- 2 -5.31078E-02 -3.96118E-01
- 3 -2.18497E-01 -2.30010E-01
- 4 -2.80039E-01 2.46263E-01
- 5 1.03583E-01 -9.09713E-02
- 6 -1.06927E-01 -3.52591E-01
-6 0 *********** SCCS-asn-trp
- 1 -4.99099E-01 -8.07351E-01
- 2 -1.29660E-01 -1.55795E-01
- 3 -1.28933E-01 -5.85417E-02
- 4 -7.80390E-03 1.45275E-02
- 5 -1.31421E-01 -6.70676E-02
- 6 -3.22116E-02 -1.78027E-01
-6 0 *********** SCCS-asn-tyr
- 1 -5.05318E-01 -7.81759E-01
- 2 -2.49523E-01 -1.56773E-01
- 3 -1.39998E-01 -2.35873E-01
- 4 -1.42535E-01 1.63922E-01
- 5 4.76773E-02 -1.39603E-01
- 6 -1.47019E-01 -4.21563E-01
-6 0 *********** SCCS-asn-ala
- 1 -2.65872E-01 -6.13325E-01
- 2 3.86720E-01 -5.51795E-01
- 3 -3.89547E-01 3.96087E-03
- 4 5.67089E-02 1.02255E-02
- 5 -3.22979E-01 -2.48239E-02
- 6 9.74780E-02 5.91367E-02
-6 0 *********** SCCS-asn-gly
+4 0 *********** SCCS-gln-thr
+ 1 3.72524E-01 -4.51041E-01
+ 2 1.52057E-01 1.40094E-01
+ 3 3.02990E-02 -1.91968E-02
+ 4 -3.59983E-03 -2.59568E-02
+4 0 *********** SCCS-gln-ser
+ 1 7.06676E-01 -3.49953E-01
+ 2 2.15481E-02 2.18139E-01
+ 3 -7.06996E-03 3.61775E-02
+ 4 3.88715E-02 -1.19804E-02
+4 0 *********** SCCS-gln-gln
+ 1 3.45167E-01 -4.83364E-01
+ 2 1.09744E-01 8.74874E-02
+ 3 -1.41305E-02 1.23287E-02
+ 4 -2.35528E-02 4.53373E-04
+4 0 *********** SCCS-gln-asn
+ 1 6.05408E-01 -3.11408E-01
+ 2 -1.21350E-02 1.78216E-01
+ 3 -3.39004E-02 2.93603E-02
+ 4 1.65826E-02 2.08530E-02
+4 0 *********** SCCS-gln-glu
+ 1 3.57855E-01 -5.33509E-01
+ 2 1.46387E-01 6.89503E-02
+ 3 3.22538E-03 4.56514E-03
+ 4 -2.05340E-02 -7.87216E-03
+4 0 *********** SCCS-gln-asp
+ 1 6.42044E-01 -3.21931E-01
+ 2 1.24171E-02 1.71516E-01
+ 3 -2.30269E-02 3.44125E-02
+ 4 3.71335E-02 2.06943E-02
+4 0 *********** SCCS-gln-his
+ 1 5.81423E-01 -3.02122E-01
+ 2 -1.66860E-02 1.20394E-01
+ 3 -2.64290E-02 -1.31693E-02
+ 4 4.12599E-02 3.48810E-02
+4 0 *********** SCCS-gln-arg
+ 1 1.32993E-01 -4.67945E-01
+ 2 1.75658E-01 -4.29680E-02
+ 3 -4.65605E-03 -3.18778E-02
+ 4 -1.33197E-02 4.57256E-03
+4 0 *********** SCCS-gln-lys
+ 1 1.12536E-01 -4.26087E-01
+ 2 2.09075E-01 -1.43530E-02
+ 3 8.78889E-03 -2.92447E-02
+ 4 -2.20890E-02 3.54246E-03
+4 0 *********** SCCS-gln-pro
+ 1 7.34775E-01 -2.94956E-01
+ 2 -8.33276E-03 2.05041E-01
+ 3 8.67681E-03 1.83067E-02
+ 4 9.83198E-02 6.77699E-03
+4 0 *********** SCCS-asn-cys
+ 1 5.04335E-01 -7.39264E-01
+ 2 1.65204E-01 3.02986E-01
+ 3 -5.78337E-02 -3.47671E-02
+ 4 -2.37965E-02 1.77826E-02
+4 0 *********** SCCS-asn-met
+ 1 1.77178E-01 -6.13369E-01
+ 2 3.39709E-01 6.61443E-02
+ 3 -2.62225E-02 -8.08027E-02
+ 4 -1.42941E-02 2.09088E-02
+4 0 *********** SCCS-asn-phe
+ 1 2.14472E-01 -6.53363E-01
+ 2 3.62519E-01 -1.10511E-01
+ 3 -7.57402E-02 3.28164E-03
+ 4 -1.23714E-02 5.52818E-02
+4 0 *********** SCCS-asn-ile
+ 1 3.25121E-01 -7.10652E-01
+ 2 3.76442E-01 1.57116E-01
+ 3 1.16290E-02 -9.84483E-02
+ 4 -8.25687E-03 -3.35860E-04
+4 0 *********** SCCS-asn-leu
+ 1 1.29184E-01 -5.84371E-01
+ 2 5.58686E-01 -7.39847E-02
+ 3 -5.71794E-02 -1.53406E-02
+ 4 9.76635E-03 6.80307E-03
+4 0 *********** SCCS-asn-val
+ 1 2.15116E-01 -6.63449E-01
+ 2 4.94741E-01 1.82214E-01
+ 3 2.16339E-02 -1.10162E-01
+ 4 -1.48604E-02 6.05498E-03
+4 0 *********** SCCS-asn-trp
+ 1 2.23583E-01 -7.19405E-01
+ 2 2.14051E-01 -5.47469E-02
+ 3 -5.78897E-02 -9.80034E-03
+ 4 5.28692E-03 3.83168E-02
+4 0 *********** SCCS-asn-tyr
+ 1 1.74799E-01 -6.51312E-01
+ 2 3.33445E-01 -1.55248E-01
+ 3 -4.96369E-02 -1.86586E-02
+ 4 1.13473E-04 6.49258E-02
+4 0 *********** SCCS-asn-ala
+ 1 3.93563E-01 -3.61207E-01
+ 2 4.16689E-01 3.56767E-01
+ 3 -4.80322E-02 -1.47193E-01
+ 4 -1.46148E-02 -8.93927E-03
+4 0 *********** SCCS-asn-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-asn-thr
- 1 -3.05529E-01 -7.17547E-01
- 2 1.89052E-01 -4.54335E-01
- 3 -2.86506E-01 -1.86811E-01
- 4 -1.13599E-01 -5.41133E-02
- 5 -1.19741E-01 -4.42205E-02
- 6 -5.43206E-02 -6.50022E-02
-6 0 *********** SCCS-asn-ser
- 1 -6.89183E-01 -1.79737E+00
- 2 3.94757E-01 -1.47323E-01
- 3 -2.22155E-01 -2.68679E-01
- 4 -2.72310E-02 2.43246E-02
- 5 -6.40004E-02 -8.64620E-02
- 6 -6.13375E-02 -4.74422E-01
-6 0 *********** SCCS-asn-gln
- 1 -4.93659E-01 -8.60870E-01
- 2 7.12198E-02 -1.54778E-01
- 3 -1.24473E-01 -6.06627E-02
- 4 -1.46071E-03 2.23055E-02
- 5 -6.06458E-02 -7.47387E-02
- 6 -4.79627E-02 -2.01273E-01
-6 0 *********** SCCS-asn-asn
- 1 -5.08546E-02 -1.10601E+00
- 2 3.62859E-01 2.06370E-01
- 3 -2.19120E-01 -1.40081E-01
- 4 9.68600E-02 3.05455E-04
- 5 -1.13958E-01 -5.14073E-02
- 6 2.73311E-02 -3.72200E-01
-6 0 *********** SCCS-asn-glu
- 1 -5.82316E-01 -9.26292E-01
- 2 2.82638E-02 -2.66133E-01
- 3 -1.48082E-01 -5.10984E-02
- 4 -3.95615E-02 4.71363E-03
- 5 -7.65485E-02 -8.38700E-02
- 6 -6.27427E-02 -1.73783E-01
-6 0 *********** SCCS-asn-asp
- 1 1.58497E-01 -9.20923E-01
- 2 6.98850E-01 1.19949E-01
- 3 -1.32246E-01 -2.58848E-01
- 4 -1.45539E-02 1.08537E-01
- 5 1.21489E-03 -1.11350E-01
- 6 -4.98969E-02 -4.92381E-01
-6 0 *********** SCCS-asn-his
- 1 -4.70519E-02 -1.35731E+00
- 2 4.06081E-02 1.86889E-01
- 3 -1.67461E-01 -3.27274E-02
- 4 -7.99144E-03 3.11632E-02
- 5 -8.77365E-02 -6.67197E-02
- 6 -5.82699E-02 -3.84061E-01
-6 0 *********** SCCS-asn-arg
- 1 -4.82403E-01 -5.45529E-01
- 2 -1.17244E-01 -2.86891E-01
- 3 -1.67906E-01 -6.23761E-02
- 4 -4.48542E-02 5.31104E-02
- 5 -9.64431E-02 -6.25849E-02
- 6 -2.86109E-02 -1.11286E-01
-6 0 *********** SCCS-asn-lys
- 1 -4.03420E-01 -5.61829E-01
- 2 -1.35882E-01 -4.14959E-01
- 3 -1.94967E-01 -4.56707E-02
- 4 -4.83526E-02 8.49845E-02
- 5 -1.19811E-01 -5.39978E-02
- 6 -7.36229E-03 -8.95423E-02
-6 0 *********** SCCS-asn-pro
- 1 -3.67224E+00 4.68734E-02
- 2 1.77071E-01 3.46357E+00
- 3 3.13984E-01 -2.85396E-01
- 4 -8.86506E-01 -5.57566E-01
- 5 -1.14756E+00 9.67820E-01
- 6 5.91455E-01 -7.81408E-02
-6 0 *********** SCCS-glu-cys
- 1 -4.83925E-01 -6.51298E-01
- 2 4.28198E-01 6.62544E-02
- 3 -1.08338E-01 -9.99842E-03
- 4 1.38581E-01 1.40218E-02
- 5 -8.30239E-02 -3.01554E-02
- 6 2.99992E-02 -1.72604E-01
-6 0 *********** SCCS-glu-met
- 1 -3.93119E-01 -3.98059E-01
- 2 9.69646E-02 -2.72972E-01
- 3 -1.37647E-01 -9.00019E-02
- 4 -4.46393E-02 1.15511E-02
- 5 -1.00741E-01 -3.89598E-02
- 6 -2.45381E-02 -6.15883E-02
-6 0 *********** SCCS-glu-phe
- 1 -3.95727E-01 -3.74910E-01
- 2 -1.01446E-01 -2.38418E-01
- 3 -1.30590E-01 -1.93845E-01
- 4 -1.19484E-01 7.51964E-02
- 5 -5.30626E-02 -5.84511E-02
- 6 -8.15070E-02 -1.80758E-01
-6 0 *********** SCCS-glu-ile
- 1 -3.76411E-01 -4.69599E-01
- 2 1.27676E-01 -2.87101E-01
- 3 -1.87287E-01 -5.72492E-02
- 4 -5.37534E-02 -2.61303E-02
- 5 -1.47236E-01 -2.76259E-02
- 6 -2.62566E-02 -1.26201E-02
-6 0 *********** SCCS-glu-leu
- 1 -4.24362E-01 -2.20791E-01
- 2 -9.48430E-02 -4.67883E-01
- 3 -1.29599E-01 -1.87328E-01
- 4 -7.47320E-02 7.40743E-02
- 5 -1.55034E-01 -5.66349E-02
- 6 -2.11177E-02 -6.92212E-02
-6 0 *********** SCCS-glu-val
- 1 -4.62405E-01 -3.55735E-01
- 2 7.06503E-02 -3.87041E-01
- 3 -1.14871E-01 -1.22447E-01
- 4 -1.53633E-01 9.45069E-02
- 5 -6.44192E-03 -9.52620E-02
- 6 -8.99715E-02 -1.38035E-01
-6 0 *********** SCCS-glu-trp
- 1 -4.24069E-01 -4.42051E-01
- 2 8.70206E-02 -2.06026E-01
- 3 -1.61927E-01 -1.04064E-01
- 4 -3.16868E-02 1.19989E-02
- 5 -1.22331E-01 -3.34510E-02
- 6 -2.03725E-02 -9.52521E-02
-6 0 *********** SCCS-glu-tyr
- 1 -4.12882E-01 -3.75196E-01
- 2 -9.64704E-02 -1.81167E-01
- 3 -1.47505E-01 -1.66643E-01
- 4 -7.52565E-02 6.90457E-02
- 5 -7.95121E-02 -5.76465E-02
- 6 -4.72807E-02 -1.87221E-01
-6 0 *********** SCCS-glu-ala
- 1 -4.50264E-01 -2.41613E-01
- 2 2.92979E-01 -4.03720E-01
- 3 -1.07326E-01 -2.86858E-02
- 4 1.07420E-02 9.28010E-03
- 5 -1.62466E-01 -6.07238E-02
- 6 3.08043E-02 1.59837E-02
-6 0 *********** SCCS-glu-gly
+4 0 *********** SCCS-asn-thr
+ 1 3.01041E-01 -6.87682E-01
+ 2 3.44749E-01 1.81216E-01
+ 3 4.16396E-02 -8.47487E-02
+ 4 -4.45363E-02 -4.98194E-03
+4 0 *********** SCCS-asn-ser
+ 1 7.09361E-01 -7.69862E-01
+ 2 8.21010E-04 4.13794E-01
+ 3 -1.25945E-01 6.26593E-02
+ 4 -1.76184E-02 -1.81647E-02
+4 0 *********** SCCS-asn-gln
+ 1 2.43864E-01 -7.20861E-01
+ 2 1.91086E-01 1.52343E-01
+ 3 -2.69797E-02 6.76108E-03
+ 4 -4.41378E-02 4.58135E-02
+4 0 *********** SCCS-asn-asn
+ 1 7.30592E-01 -5.65273E-01
+ 2 -2.75405E-01 2.93682E-01
+ 3 -2.05638E-02 -9.66590E-03
+ 4 9.89644E-03 8.66577E-02
+4 0 *********** SCCS-asn-glu
+ 1 2.14632E-01 -7.88719E-01
+ 2 2.97187E-01 1.15949E-01
+ 3 -2.46968E-02 -1.43120E-03
+ 4 -1.08428E-02 2.79630E-02
+4 0 *********** SCCS-asn-asp
+ 1 8.22186E-01 -5.80883E-01
+ 2 -2.44168E-01 3.22652E-01
+ 3 -1.32451E-02 2.30903E-02
+ 4 1.41592E-02 7.94026E-02
+4 0 *********** SCCS-asn-his
+ 1 7.19791E-01 -5.65635E-01
+ 2 -2.64163E-01 1.25458E-01
+ 3 1.91594E-02 -1.18050E-01
+ 4 3.78487E-02 5.24126E-02
+4 0 *********** SCCS-asn-arg
+ 1 6.43093E-02 -6.13105E-01
+ 2 3.08886E-01 -7.30893E-02
+ 3 -6.80516E-02 -4.40328E-02
+ 4 -5.48462E-03 1.77752E-02
+4 0 *********** SCCS-asn-lys
+ 1 3.21498E-02 -5.46633E-01
+ 2 4.33619E-01 -3.83997E-02
+ 3 -2.22108E-02 -8.69999E-02
+ 4 -1.23561E-03 5.22853E-03
+4 0 *********** SCCS-asn-pro
+ 1 7.96828E-01 -6.84591E-01
+ 2 -5.26010E-02 4.56772E-01
+ 3 -1.28984E-01 -2.92455E-04
+ 4 1.10783E-01 -1.48442E-02
+4 0 *********** SCCS-glu-cys
+ 1 6.53687E-01 -4.34079E-01
+ 2 1.22866E-01 1.34640E-01
+ 3 -2.24722E-02 -4.32294E-02
+ 4 1.06070E-02 -7.61586E-03
+4 0 *********** SCCS-glu-met
+ 1 2.86066E-01 -4.82459E-01
+ 2 2.06963E-01 -3.97914E-03
+ 3 -2.44571E-02 -3.93101E-02
+ 4 -1.04628E-02 -4.58590E-03
+4 0 *********** SCCS-glu-phe
+ 1 2.15763E-01 -5.46055E-01
+ 2 1.95022E-01 -1.48417E-01
+ 3 -3.36618E-02 -1.10796E-02
+ 4 -4.21384E-04 2.54868E-02
+4 0 *********** SCCS-glu-ile
+ 1 4.41373E-01 -5.32014E-01
+ 2 2.34752E-01 2.82503E-02
+ 3 -2.51430E-02 -6.01055E-02
+ 4 7.50058E-03 -1.34671E-02
+4 0 *********** SCCS-glu-leu
+ 1 1.37141E-01 -4.97969E-01
+ 2 2.90161E-01 -1.08859E-01
+ 3 5.04866E-04 -1.64053E-02
+ 4 -2.79236E-02 -8.20153E-03
+4 0 *********** SCCS-glu-val
+ 1 3.34791E-01 -5.20620E-01
+ 2 3.01756E-01 2.81141E-02
+ 3 -8.05096E-03 -4.20069E-02
+ 4 -1.80520E-02 -3.07707E-02
+4 0 *********** SCCS-glu-trp
+ 1 3.03533E-01 -5.52919E-01
+ 2 1.40792E-01 -4.61200E-02
+ 3 -4.27719E-02 -1.67625E-02
+ 4 -2.07383E-03 9.02039E-03
+4 0 *********** SCCS-glu-tyr
+ 1 1.99606E-01 -5.47577E-01
+ 2 1.61049E-01 -1.51422E-01
+ 3 -3.22340E-02 -1.13962E-02
+ 4 -1.61419E-03 1.55745E-02
+4 0 *********** SCCS-glu-ala
+ 1 2.60662E-01 -3.28473E-01
+ 2 3.02258E-01 1.58958E-01
+ 3 5.30925E-03 -2.35769E-02
+ 4 1.05477E-02 -3.63619E-02
+4 0 *********** SCCS-glu-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-glu-thr
- 1 -3.46300E-01 -4.54820E-01
- 2 2.79076E-01 -2.35428E-01
- 3 -1.60513E-01 -2.12761E-01
- 4 -1.66896E-01 2.87269E-02
- 5 3.02522E-02 -8.25169E-02
- 6 -1.34128E-01 -1.92987E-01
-6 0 *********** SCCS-glu-ser
- 1 -8.09848E-01 -8.35414E-01
- 2 6.96541E-01 3.10409E-01
- 3 1.97702E-02 -2.23115E-01
- 4 5.38167E-02 9.85310E-02
- 5 9.26524E-02 -6.68563E-02
- 6 -2.36952E-02 -4.82460E-01
-6 0 *********** SCCS-glu-gln
- 1 -4.64697E-01 -4.83320E-01
- 2 2.66658E-01 -1.49366E-01
- 3 -1.15317E-01 -1.02810E-01
- 4 -3.67854E-04 1.04164E-02
- 5 -8.83899E-02 -3.72327E-02
- 6 -1.16800E-02 -1.25933E-01
-6 0 *********** SCCS-glu-asn
- 1 -4.02183E-01 -7.44981E-01
- 2 3.80473E-01 2.59710E-01
- 3 -1.32614E-01 3.60203E-02
- 4 1.31910E-01 3.14564E-02
- 5 -1.67914E-01 3.70731E-03
- 6 4.12805E-02 -2.09748E-01
-6 0 *********** SCCS-glu-glu
- 1 -5.09946E-01 -4.76098E-01
- 2 2.75008E-01 -2.48104E-01
- 3 -1.34941E-01 -1.19108E-01
- 4 -2.49491E-02 -1.14406E-02
- 5 -1.04198E-01 -4.35712E-02
- 6 -2.61808E-02 -8.55270E-02
-6 0 *********** SCCS-glu-asp
- 1 -2.84960E-01 -6.02513E-01
- 2 4.48531E-01 1.03066E-01
- 3 -1.40949E-01 8.08122E-02
- 4 1.25542E-01 1.57985E-02
- 5 -1.16764E-01 -7.08610E-03
- 6 4.35504E-02 -1.12851E-01
-6 0 *********** SCCS-glu-his
- 1 -4.07188E-01 -7.83162E-01
- 2 3.00161E-01 3.13014E-01
- 3 -1.63240E-01 -7.26344E-03
- 4 5.67369E-02 -6.28908E-04
- 5 -9.20148E-02 -3.56579E-02
- 6 1.68771E-02 -2.72410E-01
-6 0 *********** SCCS-glu-arg
- 1 -4.18216E-01 -2.97057E-01
- 2 -3.33698E-02 -2.66117E-01
- 3 -1.38048E-01 -1.40957E-01
- 4 -8.99499E-02 7.72389E-02
- 5 -6.26684E-02 -5.93368E-02
- 6 -5.42176E-02 -1.31592E-01
-6 0 *********** SCCS-glu-lys
- 1 -3.93136E-01 -2.92323E-01
- 2 -3.26113E-04 -3.79367E-01
- 3 -1.39488E-01 -1.16637E-01
- 4 -4.45234E-02 6.53483E-02
- 5 -1.58335E-01 -5.34744E-02
- 6 -4.87018E-03 -7.21846E-02
-6 0 *********** SCCS-glu-pro
- 1 -3.22728E+01 2.76828E-01
- 2 3.15410E+01 2.14163E+00
- 3 -3.21600E+01 7.20103E-01
- 4 3.15072E+01 -8.47577E-02
- 5 -3.27421E+01 5.34799E-01
- 6 1.58796E+01 1.98602E-01
-6 0 *********** SCCS-asp-cys
- 1 -3.52954E-01 -1.21645E+00
- 2 2.21333E-01 -1.93029E-01
- 3 -2.18015E-01 -7.31833E-02
- 4 -1.87280E-03 8.21963E-02
- 5 6.10175E-03 -7.28159E-02
- 6 -6.41219E-02 -2.90572E-01
-6 0 *********** SCCS-asp-met
- 1 -3.95745E-01 -7.03791E-01
- 2 -1.42978E-02 -3.31229E-01
- 3 -1.75391E-01 -6.01463E-02
- 4 -7.96403E-02 7.63324E-02
- 5 -4.23240E-02 -5.55756E-02
- 6 -6.04913E-02 -1.36538E-01
-6 0 *********** SCCS-asp-phe
- 1 -4.56026E-01 -7.92210E-01
- 2 -2.09706E-01 -2.49879E-01
- 3 -1.12844E-01 -2.25917E-01
- 4 -1.07112E-01 1.42175E-01
- 5 3.79239E-02 -1.22999E-01
- 6 -1.20597E-01 -3.59660E-01
-6 0 *********** SCCS-asp-ile
- 1 -3.95318E-01 -9.10024E-01
- 2 -2.67416E-02 -3.48730E-01
- 3 -3.02038E-01 -9.96869E-02
- 4 -1.58748E-01 1.41879E-01
- 5 2.93623E-02 -2.62496E-02
- 6 -7.20971E-02 -2.04820E-01
-6 0 *********** SCCS-asp-leu
- 1 -4.22149E-01 -6.34803E-01
- 2 -1.45220E-01 -5.77916E-01
- 3 -2.51513E-01 -6.08448E-02
- 4 1.08794E-02 8.73552E-02
- 5 -2.17136E-01 -3.99329E-02
- 6 4.45664E-02 -4.44983E-02
-6 0 *********** SCCS-asp-val
- 1 -4.67524E-01 -7.80561E-01
- 2 -1.03988E-02 -3.66211E-01
- 3 -2.37349E-01 -2.60624E-01
- 4 -2.38084E-01 1.91404E-01
- 5 1.16954E-01 -6.17612E-02
- 6 -1.28134E-01 -3.18337E-01
-6 0 *********** SCCS-asp-trp
- 1 -4.63547E-01 -8.07769E-01
- 2 -1.23520E-01 -1.64406E-01
- 3 -1.27800E-01 -5.46336E-02
- 4 -1.23681E-02 1.79990E-02
- 5 -1.19191E-01 -6.49684E-02
- 6 -3.83501E-02 -1.72175E-01
-6 0 *********** SCCS-asp-tyr
- 1 -4.76082E-01 -7.86935E-01
- 2 -2.30890E-01 -1.81926E-01
- 3 -1.49339E-01 -2.35846E-01
- 4 -1.49388E-01 1.57514E-01
- 5 4.67536E-02 -1.46085E-01
- 6 -1.46854E-01 -4.18679E-01
-6 0 *********** SCCS-asp-ala
- 1 -2.32058E-01 -6.32426E-01
- 2 4.50134E-01 -5.03699E-01
- 3 -4.30041E-01 -2.09810E-02
- 4 1.12163E-01 -4.00665E-02
- 5 -3.13276E-01 3.18392E-02
- 6 6.21935E-02 1.02867E-01
-6 0 *********** SCCS-asp-gly
+4 0 *********** SCCS-glu-thr
+ 1 4.14591E-01 -4.92306E-01
+ 2 2.06813E-01 1.14666E-01
+ 3 1.04520E-02 -4.84441E-02
+ 4 1.55668E-03 -2.39491E-02
+4 0 *********** SCCS-glu-ser
+ 1 8.20411E-01 -3.74788E-01
+ 2 1.41651E-01 2.12538E-01
+ 3 -6.21859E-03 -1.79885E-02
+ 4 3.80900E-02 -4.92337E-03
+4 0 *********** SCCS-glu-gln
+ 1 3.76192E-01 -5.30580E-01
+ 2 1.42354E-01 5.64657E-02
+ 3 -5.15342E-02 -1.01811E-04
+ 4 -2.54485E-02 8.47337E-03
+4 0 *********** SCCS-glu-asn
+ 1 6.68741E-01 -3.25679E-01
+ 2 5.95386E-02 2.08143E-01
+ 3 -3.75853E-02 -3.46718E-02
+ 4 8.52328E-03 3.37193E-02
+4 0 *********** SCCS-glu-glu
+ 1 3.97863E-01 -5.90618E-01
+ 2 1.81295E-01 2.15547E-02
+ 3 -3.83104E-02 -5.40193E-03
+ 4 -1.75773E-02 -1.93044E-03
+4 0 *********** SCCS-glu-asp
+ 1 7.26648E-01 -3.38866E-01
+ 2 9.14696E-02 2.01477E-01
+ 3 -2.62763E-03 -2.50737E-02
+ 4 1.37337E-02 3.33863E-02
+4 0 *********** SCCS-glu-his
+ 1 6.45652E-01 -3.22105E-01
+ 2 2.88133E-02 1.41654E-01
+ 3 1.41278E-02 -7.41916E-02
+ 4 1.84667E-02 3.66436E-02
+4 0 *********** SCCS-glu-arg
+ 1 1.47048E-01 -5.09324E-01
+ 2 1.93342E-01 -8.72346E-02
+ 3 -2.65704E-02 -3.06199E-02
+ 4 -1.38107E-02 1.72608E-03
+4 0 *********** SCCS-glu-lys
+ 1 1.27552E-01 -4.60023E-01
+ 2 2.41286E-01 -5.68118E-02
+ 3 -1.10430E-02 -2.82039E-02
+ 4 -1.80561E-02 -1.09528E-02
+4 0 *********** SCCS-glu-pro
+ 1 8.38284E-01 -3.23945E-01
+ 2 1.06881E-01 1.92895E-01
+ 3 5.24047E-02 -7.01651E-02
+ 4 1.19062E-01 1.62763E-02
+4 0 *********** SCCS-asp-cys
+ 1 4.83105E-01 -8.50263E-01
+ 2 -4.11716E-02 3.00082E-01
+ 3 3.82279E-02 -1.71003E-01
+ 4 -8.20459E-02 -5.36035E-02
+4 0 *********** SCCS-asp-met
+ 1 1.40426E-01 -6.26797E-01
+ 2 2.56246E-01 1.79435E-01
+ 3 -2.10572E-02 -1.16520E-01
+ 4 -4.84116E-02 3.00437E-02
+4 0 *********** SCCS-asp-phe
+ 1 1.56568E-01 -6.37251E-01
+ 2 3.27439E-01 1.39893E-02
+ 3 -1.14869E-01 -8.95667E-03
+ 4 -2.77096E-02 6.44187E-02
+4 0 *********** SCCS-asp-ile
+ 1 2.15592E-01 -7.70118E-01
+ 2 2.70457E-01 2.89710E-01
+ 3 3.17738E-03 -1.85282E-01
+ 4 -6.27790E-02 2.14411E-02
+4 0 *********** SCCS-asp-leu
+ 1 -2.93893E-02 -5.75986E-01
+ 2 5.44014E-01 1.32738E-01
+ 3 -1.10651E-01 -3.60087E-02
+ 4 2.26130E-02 4.31327E-02
+4 0 *********** SCCS-asp-val
+ 1 1.07323E-01 -7.01274E-01
+ 2 3.61795E-01 3.45811E-01
+ 3 -1.24262E-02 -1.76175E-01
+ 4 -7.10526E-02 3.98444E-02
+4 0 *********** SCCS-asp-trp
+ 1 1.86159E-01 -7.22919E-01
+ 2 1.85783E-01 4.21482E-02
+ 3 -9.32844E-02 -5.54396E-02
+ 4 -2.55758E-02 6.06168E-02
+4 0 *********** SCCS-asp-tyr
+ 1 1.39018E-01 -6.33202E-01
+ 2 3.11716E-01 -1.63136E-02
+ 3 -9.24718E-02 -1.39666E-02
+ 4 -3.23903E-02 7.58724E-02
+4 0 *********** SCCS-asp-ala
+ 1 2.56086E-01 -3.90897E-01
+ 2 2.57773E-01 4.97315E-01
+ 3 5.59778E-03 -1.74054E-01
+ 4 -5.38422E-02 1.42699E-02
+4 0 *********** SCCS-asp-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-asp-thr
- 1 -2.96801E-01 -7.11565E-01
- 2 2.07561E-01 -4.28272E-01
- 3 -2.75265E-01 -1.96542E-01
- 4 -1.02218E-01 -5.41524E-02
- 5 -1.21109E-01 -5.19017E-02
- 6 -5.22935E-02 -8.32035E-02
-6 0 *********** SCCS-asp-ser
- 1 -5.19174E-01 -1.72903E+00
- 2 5.48601E-01 -9.01117E-02
- 3 -1.07748E-01 -2.61897E-01
- 4 3.06619E-02 6.93575E-02
- 5 -1.37603E-03 -5.34243E-02
- 6 -5.73852E-02 -4.81042E-01
-6 0 *********** SCCS-asp-gln
- 1 -4.61379E-01 -8.58253E-01
- 2 8.17725E-02 -1.51520E-01
- 3 -1.30568E-01 -6.45556E-02
- 4 -8.74168E-03 2.88781E-02
- 5 -4.98967E-02 -7.09336E-02
- 6 -5.40534E-02 -2.01335E-01
-6 0 *********** SCCS-asp-asn
- 1 -2.24117E-03 -1.07526E+00
- 2 3.79431E-01 2.34388E-01
- 3 -2.13192E-01 -1.07573E-01
- 4 9.44475E-02 2.95296E-02
- 5 -1.65426E-01 -3.27545E-02
- 6 2.88829E-02 -3.62430E-01
-6 0 *********** SCCS-asp-glu
- 1 -5.43235E-01 -9.33408E-01
- 2 3.77760E-02 -2.55719E-01
- 3 -1.63582E-01 -5.75832E-02
- 4 -3.43118E-02 1.69303E-02
- 5 -6.61767E-02 -7.15137E-02
- 6 -6.05608E-02 -1.77847E-01
-6 0 *********** SCCS-asp-asp
- 1 2.17163E-01 -8.90870E-01
- 2 6.60009E-01 1.29795E-01
- 3 -8.30166E-02 -2.40335E-01
- 4 -5.40702E-02 7.35194E-02
- 5 1.07373E-02 -7.22221E-02
- 6 -4.37594E-02 -4.23589E-01
-6 0 *********** SCCS-asp-his
- 1 6.09761E-02 -1.31169E+00
- 2 -2.13485E-02 1.72700E-01
- 3 -1.18879E-01 -4.46483E-02
- 4 -4.93479E-02 5.14306E-02
- 5 -8.30584E-02 -7.18622E-02
- 6 -4.02941E-02 -3.93830E-01
-6 0 *********** SCCS-asp-arg
- 1 -4.63187E-01 -5.50821E-01
- 2 -7.41568E-02 -2.97612E-01
- 3 -2.11668E-01 -6.72155E-02
- 4 8.58760E-03 3.28651E-02
- 5 -1.31738E-01 -3.72341E-02
- 6 -9.44403E-03 -8.43181E-02
-6 0 *********** SCCS-asp-lys
- 1 -3.83336E-01 -5.61383E-01
- 2 -1.11841E-01 -4.25025E-01
- 3 -1.90188E-01 -4.98107E-02
- 4 -5.88165E-02 8.49811E-02
- 5 -1.07852E-01 -5.58818E-02
- 6 -9.66201E-03 -8.16972E-02
-6 0 *********** SCCS-asp-pro
- 1 -2.83195E+00 1.42514E-01
- 2 1.40687E-01 2.73096E+00
- 3 1.93788E-01 8.37874E-02
- 4 -6.30711E-01 -3.69117E-01
- 5 -1.16730E+00 8.66219E-01
- 6 4.46134E-01 1.07090E-01
-6 0 *********** SCCS-his-cys
- 1 -3.20786E-01 -1.12470E+00
- 2 3.59659E-01 9.54694E-02
- 3 -1.82801E-01 -2.11047E-01
- 4 -6.08196E-02 1.23057E-01
- 5 4.55057E-02 -8.97291E-02
- 6 -9.88602E-02 -4.81590E-01
-6 0 *********** SCCS-his-met
- 1 -3.83211E-01 -6.53762E-01
- 2 7.59601E-03 -3.10874E-01
- 3 -1.75426E-01 -7.12684E-02
- 4 -7.20627E-02 5.19460E-02
- 5 -5.70430E-02 -4.96980E-02
- 6 -5.16797E-02 -1.16673E-01
-6 0 *********** SCCS-his-phe
- 1 -4.42526E-01 -7.17041E-01
- 2 -1.43055E-01 -3.29144E-01
- 3 -2.48077E-01 -4.17076E-02
- 4 5.84178E-02 2.13563E-02
- 5 -2.11381E-01 -3.95820E-02
- 6 1.66644E-02 -8.90761E-02
-6 0 *********** SCCS-his-ile
- 1 -4.28888E-01 -7.81529E-01
- 2 -1.92582E-02 -3.88087E-01
- 3 -2.51867E-01 -6.02494E-02
- 4 -1.27270E-01 8.07236E-02
- 5 -2.97712E-02 -3.07792E-02
- 6 -6.16994E-02 -1.12957E-01
-6 0 *********** SCCS-his-leu
- 1 -4.03019E-01 -5.18938E-01
- 2 -2.07036E-01 -5.87930E-01
- 3 -1.58196E-01 -1.17402E-01
- 4 -1.49763E-01 1.54545E-01
- 5 -4.75673E-02 -8.21038E-02
- 6 -4.47958E-02 -1.30153E-01
-6 0 *********** SCCS-his-val
- 1 -4.35109E-01 -6.79112E-01
- 2 4.42526E-02 -4.97888E-01
- 3 -3.90576E-01 -4.11183E-02
- 4 -2.32712E-02 1.34246E-02
- 5 -1.92111E-01 1.68854E-02
- 6 1.54815E-02 3.53664E-02
-6 0 *********** SCCS-his-trp
- 1 -4.76160E-01 -7.26406E-01
- 2 -1.15604E-01 -1.94527E-01
- 3 -1.30985E-01 -1.21573E-01
- 4 -6.81380E-02 5.68696E-02
- 5 -6.52561E-02 -7.30112E-02
- 6 -6.49105E-02 -2.14156E-01
-6 0 *********** SCCS-his-tyr
- 1 -4.19319E-01 -7.25369E-01
- 2 -1.81033E-01 -2.54103E-01
- 3 -1.61864E-01 -8.54866E-02
- 4 -1.79162E-02 4.53691E-02
- 5 -1.07122E-01 -9.38599E-02
- 6 -5.47608E-02 -1.89819E-01
-6 0 *********** SCCS-his-ala
- 1 -2.94434E-01 -5.57306E-01
- 2 3.87727E-01 -3.20713E-01
- 3 -1.46438E-01 -2.59533E-01
- 4 -2.50631E-01 9.81309E-02
- 5 1.24331E-01 -7.80872E-02
- 6 -1.58315E-01 -2.48968E-01
-6 0 *********** SCCS-his-gly
+4 0 *********** SCCS-asp-thr
+ 1 2.03327E-01 -7.52847E-01
+ 2 2.11769E-01 3.13518E-01
+ 3 4.13921E-02 -1.45323E-01
+ 4 -7.74979E-02 -1.39205E-02
+4 0 *********** SCCS-asp-ser
+ 1 7.12075E-01 -9.85017E-01
+ 2 -3.08707E-01 2.23254E-01
+ 3 1.47396E-02 -5.12763E-02
+ 4 1.54081E-02 -1.22346E-01
+4 0 *********** SCCS-asp-gln
+ 1 2.21200E-01 -7.68690E-01
+ 2 7.23771E-02 2.11751E-01
+ 3 -5.61602E-02 -5.74124E-02
+ 4 -8.91043E-02 3.00415E-02
+4 0 *********** SCCS-asp-asn
+ 1 6.98852E-01 -7.09029E-01
+ 2 -4.32059E-01 1.42390E-01
+ 3 -3.93393E-03 -5.02545E-02
+ 4 -5.04558E-02 -6.01278E-04
+4 0 *********** SCCS-asp-glu
+ 1 1.65649E-01 -8.47903E-01
+ 2 1.61248E-01 2.23107E-01
+ 3 -6.72565E-02 -6.83504E-02
+ 4 -7.00816E-02 4.97329E-02
+4 0 *********** SCCS-asp-asp
+ 1 7.63495E-01 -7.65348E-01
+ 2 -4.52690E-01 1.51719E-01
+ 3 1.68828E-02 -3.35116E-02
+ 4 -2.09857E-02 -2.80251E-02
+4 0 *********** SCCS-asp-his
+ 1 7.10676E-01 -6.82044E-01
+ 2 -3.51444E-01 1.93903E-02
+ 3 8.86603E-02 -1.24592E-01
+ 4 3.95921E-04 -1.62392E-02
+4 0 *********** SCCS-asp-arg
+ 1 2.65954E-02 -6.09657E-01
+ 2 3.01188E-01 6.08210E-02
+ 3 -7.38203E-02 -6.21253E-02
+ 4 -1.07636E-02 3.65483E-02
+4 0 *********** SCCS-asp-lys
+ 1 -3.73791E-02 -5.56543E-01
+ 2 4.02407E-01 1.23485E-01
+ 3 -2.51472E-02 -9.55247E-02
+ 4 -2.21670E-02 3.51783E-02
+4 0 *********** SCCS-asp-pro
+ 1 9.73967E-01 -1.11933E+00
+ 2 -3.14059E-01 2.47529E-01
+ 3 9.04799E-02 -1.17972E-01
+ 4 1.73933E-01 -1.08927E-01
+4 0 *********** SCCS-his-cys
+ 1 7.27451E-01 -6.17263E-01
+ 2 2.24001E-01 1.86860E-01
+ 3 -1.29393E-01 -4.74275E-02
+ 4 -4.47830E-03 2.39322E-02
+4 0 *********** SCCS-his-met
+ 1 2.94987E-01 -5.94858E-01
+ 2 3.46150E-01 -1.93141E-02
+ 3 -5.02700E-02 -5.86869E-02
+ 4 -1.14174E-02 -3.22966E-03
+4 0 *********** SCCS-his-phe
+ 1 2.56331E-01 -6.65620E-01
+ 2 3.20692E-01 -2.39858E-01
+ 3 -2.38650E-02 -6.01628E-02
+ 4 -2.90476E-03 4.87464E-02
+4 0 *********** SCCS-his-ile
+ 1 5.14914E-01 -6.54449E-01
+ 2 3.89567E-01 6.45248E-02
+ 3 -1.23832E-02 -9.75621E-02
+ 4 1.81857E-02 -2.40620E-02
+4 0 *********** SCCS-his-leu
+ 1 2.11255E-01 -6.01120E-01
+ 2 4.80494E-01 -1.65429E-01
+ 3 -3.59946E-02 -3.36199E-02
+ 4 -2.83814E-02 -2.57269E-02
+4 0 *********** SCCS-his-val
+ 1 3.45382E-01 -6.25744E-01
+ 2 5.10689E-01 6.28737E-02
+ 3 5.24011E-02 -5.08175E-02
+ 4 5.49148E-04 -7.00880E-02
+4 0 *********** SCCS-his-trp
+ 1 3.30128E-01 -6.99195E-01
+ 2 1.86006E-01 -9.33053E-02
+ 3 -8.47779E-02 2.85921E-03
+ 4 5.21840E-03 2.78977E-02
+4 0 *********** SCCS-his-tyr
+ 1 2.05324E-01 -6.55546E-01
+ 2 2.52059E-01 -2.50816E-01
+ 3 -4.66802E-02 -7.38547E-02
+ 4 -1.96874E-02 4.25820E-02
+4 0 *********** SCCS-his-ala
+ 1 3.78082E-01 -3.77172E-01
+ 2 4.30375E-01 2.55483E-01
+ 3 -3.69011E-02 -1.48321E-01
+ 4 3.08071E-03 -8.23733E-02
+4 0 *********** SCCS-his-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-his-thr
- 1 -3.18023E-01 -6.46140E-01
- 2 2.15357E-01 -5.46092E-01
- 3 -2.44200E-01 -1.09070E-01
- 4 -5.82679E-02 -1.04531E-01
- 5 -1.47183E-01 -4.02594E-02
- 6 -3.59212E-02 5.03705E-02
-6 0 *********** SCCS-his-ser
- 1 -4.04880E-01 -1.38273E+00
- 2 7.34967E-01 1.34541E-01
- 3 -1.40744E-01 -1.93286E-01
- 4 1.24271E-01 9.80781E-03
- 5 -8.34007E-02 -4.13262E-02
- 6 1.77648E-02 -4.05378E-01
-6 0 *********** SCCS-his-gln
- 1 -4.45795E-01 -7.91044E-01
- 2 1.25418E-01 -1.62270E-01
- 3 -8.61751E-02 -1.11377E-01
- 4 -1.47294E-02 4.27514E-02
- 5 -3.36547E-02 -6.12181E-02
- 6 -4.48218E-02 -2.20835E-01
-6 0 *********** SCCS-his-asn
- 1 5.34751E-02 -1.01359E+00
- 2 2.47598E-01 3.35341E-01
- 3 -1.91970E-02 -1.53944E-01
- 4 -3.54560E-02 8.50663E-02
- 5 3.08194E-02 -8.67889E-02
- 6 -6.82872E-02 -4.83537E-01
-6 0 *********** SCCS-his-glu
- 1 -5.35647E-01 -8.40455E-01
- 2 9.98811E-02 -2.62456E-01
- 3 -9.73287E-02 -1.25479E-01
- 4 -4.75192E-02 4.78952E-02
- 5 -3.81493E-02 -7.95862E-02
- 6 -6.21515E-02 -2.22484E-01
-6 0 *********** SCCS-his-asp
- 1 2.43610E-01 -7.99649E-01
- 2 5.08447E-01 1.58675E-01
- 3 -3.06751E-02 -1.29208E-01
- 4 3.78434E-02 6.97393E-02
- 5 4.84425E-03 -4.82050E-02
- 6 -2.16436E-02 -3.35345E-01
-6 0 *********** SCCS-his-his
- 1 -4.34064E-02 -1.15544E+00
- 2 1.16687E-01 2.18573E-01
- 3 -1.27751E-01 -8.29804E-02
- 4 -5.00485E-02 4.90286E-02
- 5 -7.58662E-02 -5.67584E-02
- 6 -5.92106E-02 -3.92278E-01
-6 0 *********** SCCS-his-arg
- 1 -4.28318E-01 -5.31935E-01
- 2 -9.11069E-02 -3.28713E-01
- 3 -1.91363E-01 -8.27810E-02
- 4 -2.18027E-02 6.44928E-02
- 5 -1.06718E-01 -5.26145E-02
- 6 -2.92614E-02 -1.13546E-01
-6 0 *********** SCCS-his-lys
- 1 -3.93069E-01 -5.09627E-01
- 2 -9.66449E-02 -3.96785E-01
- 3 -1.68484E-01 -1.19507E-01
- 4 -1.25212E-01 1.27382E-01
- 5 -2.32443E-02 -6.21496E-02
- 6 -5.51726E-02 -1.52834E-01
-6 0 *********** SCCS-his-pro
- 1 -1.33039E+00 -2.46431E-01
- 2 -7.20840E-01 2.73699E+00
- 3 2.42245E-01 6.28979E-01
- 4 -7.07569E-01 -1.03412E-02
- 5 -4.95009E-01 4.39986E-01
- 6 -1.68755E-03 -2.71971E-01
-6 0 *********** SCCS-arg-cys
- 1 -4.78527E-01 -8.25180E-01
- 2 4.22481E-01 5.42955E-02
- 3 -1.03641E-01 -5.55069E-02
- 4 -8.31879E-03 8.39725E-02
- 5 -1.12290E-02 -7.60975E-02
- 6 -5.47516E-02 -3.05759E-01
-6 0 *********** SCCS-arg-met
- 1 -3.85901E-01 -5.07367E-01
- 2 1.03269E-01 -2.68768E-01
- 3 -1.28126E-01 -1.11675E-01
- 4 -9.11320E-02 3.63696E-02
- 5 -5.43876E-02 -6.16474E-02
- 6 -5.28023E-02 -1.28482E-01
-6 0 *********** SCCS-arg-phe
- 1 -3.55897E-01 -5.40089E-01
- 2 -5.29262E-02 -3.23248E-01
- 3 -1.18871E-01 -1.77781E-01
- 4 -6.98542E-02 6.70838E-02
- 5 -1.05183E-01 -4.89220E-02
- 6 -6.07785E-02 -1.61799E-01
-6 0 *********** SCCS-arg-ile
- 1 -4.15161E-01 -6.01122E-01
- 2 1.17784E-01 -2.47540E-01
- 3 -1.59388E-01 -1.48810E-01
- 4 -1.48882E-01 4.36632E-02
- 5 -2.06171E-02 -5.92051E-02
- 6 -8.93784E-02 -1.74431E-01
-6 0 *********** SCCS-arg-leu
- 1 -3.58649E-01 -4.24699E-01
- 2 -3.08975E-02 -5.75090E-01
- 3 -1.68173E-01 -1.35823E-01
- 4 -6.88970E-02 5.58886E-02
- 5 -1.94943E-01 -7.01329E-02
- 6 1.03734E-02 -4.58757E-02
-6 0 *********** SCCS-arg-val
- 1 -3.92529E-01 -5.21310E-01
- 2 1.25695E-01 -3.75399E-01
- 3 -1.95371E-01 -1.64184E-01
- 4 -1.60094E-01 2.12237E-02
- 5 -6.43223E-02 -3.82304E-02
- 6 -6.85504E-02 -9.32681E-02
-6 0 *********** SCCS-arg-trp
- 1 -4.22532E-01 -5.58050E-01
- 2 1.56771E-02 -1.73637E-01
- 3 -1.08171E-01 -1.45769E-01
- 4 -7.01390E-02 2.76323E-02
- 5 -8.42156E-02 -6.02564E-02
- 6 -5.15502E-02 -1.75953E-01
-6 0 *********** SCCS-arg-tyr
- 1 -3.62805E-01 -5.49303E-01
- 2 -7.33357E-02 -2.77756E-01
- 3 -1.16191E-01 -2.08924E-01
- 4 -1.01933E-01 7.72644E-02
- 5 -4.87609E-02 -7.22764E-02
- 6 -7.31738E-02 -2.16710E-01
-6 0 *********** SCCS-arg-ala
- 1 -1.73746E-01 -4.69360E-01
- 2 3.98472E-01 -3.53253E-01
- 3 -2.30868E-01 -3.65130E-02
- 4 6.98958E-02 -5.24757E-02
- 5 -2.09480E-01 -1.26925E-02
- 6 3.13435E-02 3.98860E-02
-6 0 *********** SCCS-arg-gly
+4 0 *********** SCCS-his-thr
+ 1 4.59510E-01 -6.14091E-01
+ 2 3.88660E-01 1.39503E-01
+ 3 -1.34841E-03 -6.82452E-02
+ 4 9.93568E-03 -3.76383E-02
+4 0 *********** SCCS-his-ser
+ 1 9.85580E-01 -5.45681E-01
+ 2 2.59144E-01 3.51969E-01
+ 3 -1.14864E-01 1.59596E-02
+ 4 2.50892E-02 2.75788E-02
+4 0 *********** SCCS-his-gln
+ 1 3.80313E-01 -6.76119E-01
+ 2 2.07198E-01 7.93258E-02
+ 3 -9.89995E-02 4.14622E-02
+ 4 -3.20785E-02 3.47803E-02
+4 0 *********** SCCS-his-asn
+ 1 7.73626E-01 -5.06495E-01
+ 2 5.64873E-02 3.00441E-01
+ 3 -1.26639E-01 -2.65754E-02
+ 4 -2.40404E-02 3.74091E-02
+4 0 *********** SCCS-his-glu
+ 1 4.12108E-01 -7.48491E-01
+ 2 2.82602E-01 2.33478E-02
+ 3 -8.39211E-02 3.42983E-02
+ 4 -4.87447E-03 1.51172E-02
+4 0 *********** SCCS-his-asp
+ 1 8.79814E-01 -5.19494E-01
+ 2 9.46259E-02 2.93607E-01
+ 3 -6.31803E-02 -1.92788E-02
+ 4 6.62348E-03 4.73476E-02
+4 0 *********** SCCS-his-his
+ 1 7.89513E-01 -4.79056E-01
+ 2 -5.00126E-02 1.48417E-01
+ 3 5.22344E-03 -1.41744E-01
+ 4 2.22199E-02 3.77415E-02
+4 0 *********** SCCS-his-arg
+ 1 1.23988E-01 -6.17788E-01
+ 2 2.74559E-01 -1.55957E-01
+ 3 -5.46513E-02 -4.57139E-02
+ 4 -1.21850E-02 5.37295E-03
+4 0 *********** SCCS-his-lys
+ 1 1.36874E-01 -5.49372E-01
+ 2 3.98429E-01 -9.82276E-02
+ 3 -2.89139E-02 -6.02261E-02
+ 4 -1.21036E-02 -2.68769E-02
+4 0 *********** SCCS-his-pro
+ 1 1.11445E+00 -2.83047E-01
+ 2 9.70944E-02 5.11328E-01
+ 3 -1.58876E-01 -9.94195E-02
+ 4 5.62044E-02 1.22755E-02
+4 0 *********** SCCS-arg-cys
+ 1 4.83043E-01 8.05269E-02
+ 2 6.62858E-02 -8.76990E-02
+ 3 6.52651E-03 -6.39895E-02
+ 4 4.58964E-02 -2.81111E-02
+4 0 *********** SCCS-arg-met
+ 1 3.53757E-01 -7.83721E-02
+ 2 -5.05327E-02 -3.53860E-02
+ 3 -2.23256E-02 -8.98578E-03
+ 4 -7.23374E-03 -1.07788E-02
+4 0 *********** SCCS-arg-phe
+ 1 3.49698E-01 -1.42041E-01
+ 2 -5.78637E-02 1.33073E-02
+ 3 -3.96744E-02 1.13751E-02
+ 4 -2.68967E-02 -6.88529E-03
+4 0 *********** SCCS-arg-ile
+ 1 4.26213E-01 -4.48649E-02
+ 2 -4.21672E-02 -6.42310E-02
+ 3 -2.25076E-02 -2.02787E-02
+ 4 5.51533E-03 -2.68091E-02
+4 0 *********** SCCS-arg-leu
+ 1 3.31689E-01 -1.79217E-01
+ 2 -1.02750E-01 1.43590E-02
+ 3 -4.89729E-02 -1.11282E-02
+ 4 -5.22584E-02 -6.73114E-03
+4 0 *********** SCCS-arg-val
+ 1 4.01014E-01 -9.47134E-02
+ 2 -7.88450E-02 -5.46381E-02
+ 3 -3.42643E-02 -1.56198E-02
+ 4 -8.53573E-03 -3.14686E-02
+4 0 *********** SCCS-arg-trp
+ 1 3.77877E-01 -8.81707E-02
+ 2 -3.52631E-02 -4.05910E-02
+ 3 -2.28127E-02 3.00764E-03
+ 4 -6.61293E-03 -4.39263E-03
+4 0 *********** SCCS-arg-tyr
+ 1 3.39202E-01 -1.48287E-01
+ 2 -5.09901E-02 1.29384E-02
+ 3 -3.12958E-02 1.89707E-02
+ 4 -2.79499E-02 4.51563E-03
+4 0 *********** SCCS-arg-ala
+ 1 3.27350E-01 -4.65648E-04
+ 2 -9.34329E-02 -7.20440E-02
+ 3 1.54437E-02 -5.41022E-02
+ 4 1.50233E-02 -4.27157E-02
+4 0 *********** SCCS-arg-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-arg-thr
- 1 -4.14100E-01 -4.92274E-01
- 2 3.13638E-01 -3.28985E-01
- 3 -2.39086E-01 -1.23907E-01
- 4 2.46989E-02 -7.08241E-02
- 5 -1.99334E-01 -4.48631E-02
- 6 -1.00821E-02 -2.77504E-02
-6 0 *********** SCCS-arg-ser
- 1 -7.69408E-01 -9.77691E-01
- 2 7.93419E-01 1.49429E-01
- 3 -7.55144E-02 -5.96041E-02
- 4 2.22590E-01 2.55269E-02
- 5 -1.14764E-01 -6.36299E-03
- 6 8.87912E-02 -2.62962E-01
-6 0 *********** SCCS-arg-gln
- 1 -4.46927E-01 -6.24486E-01
- 2 1.88163E-01 -8.95421E-02
- 3 -8.32368E-02 -1.23452E-01
- 4 -3.93165E-02 2.59693E-02
- 5 -3.58699E-02 -5.34086E-02
- 6 -5.02357E-02 -2.06729E-01
-6 0 *********** SCCS-arg-asn
- 1 2.82695E-02 -8.03608E-01
- 2 1.76719E-01 4.29340E-01
- 3 -1.72577E-03 -5.88066E-02
- 4 -4.69838E-02 7.85628E-02
- 5 -1.63873E-02 -2.49263E-02
- 6 -3.61952E-02 -3.83672E-01
-6 0 *********** SCCS-arg-glu
- 1 -5.46074E-01 -6.29612E-01
- 2 1.93568E-01 -1.81833E-01
- 3 -1.01698E-01 -1.37293E-01
- 4 -6.51850E-02 2.43652E-02
- 5 -4.34599E-02 -6.05207E-02
- 6 -6.04025E-02 -1.94963E-01
-6 0 *********** SCCS-arg-asp
- 1 6.92154E-02 -6.63720E-01
- 2 4.37121E-01 4.25647E-01
- 3 -3.98101E-02 -9.77416E-02
- 4 -3.41844E-02 1.60158E-01
- 5 4.96039E-02 -3.71941E-02
- 6 -6.88111E-02 -4.39348E-01
-6 0 *********** SCCS-arg-his
- 1 -5.83580E-02 -8.76410E-01
- 2 1.39428E-01 3.87431E-01
- 3 -6.17208E-02 -4.91109E-02
- 4 -4.49201E-02 7.18106E-02
- 5 -4.05458E-02 -4.64040E-02
- 6 -5.18419E-02 -3.91509E-01
-6 0 *********** SCCS-arg-arg
- 1 -4.13589E-01 -4.17611E-01
- 2 2.12279E-02 -3.02658E-01
- 3 -1.93544E-01 -9.53490E-02
- 4 -1.25278E-02 3.24797E-02
- 5 -1.42395E-01 -3.01640E-02
- 6 -1.03181E-02 -6.73874E-02
-6 0 *********** SCCS-arg-lys
- 1 -3.51275E-01 -4.07501E-01
- 2 -1.38057E-03 -3.95271E-01
- 3 -1.46120E-01 -1.23021E-01
- 4 -9.47377E-02 6.15999E-02
- 5 -8.53676E-02 -5.32753E-02
- 6 -3.99144E-02 -8.39244E-02
-6 0 *********** SCCS-arg-pro
- 1 -5.25473E-01 1.05106E-01
- 2 -8.61041E-01 2.07328E+00
- 3 2.54418E-01 6.31488E-01
- 4 -3.59968E-01 -2.50930E-02
- 5 -6.11025E-01 2.56967E-01
- 6 -1.82642E-01 -1.32984E-01
-6 0 *********** SCCS-lys-cys
- 1 -4.83730E-01 -4.72326E-01
- 2 4.82467E-01 1.00430E-01
- 3 -7.93765E-02 -3.14817E-02
- 4 8.68180E-02 2.25662E-02
- 5 -6.03377E-02 -8.08710E-03
- 6 2.01900E-02 -1.58301E-01
-6 0 *********** SCCS-lys-met
- 1 -3.21718E-01 -2.81874E-01
- 2 1.71956E-01 -2.77428E-01
- 3 -1.12977E-01 -1.20451E-01
- 4 -6.59346E-02 1.91033E-02
- 5 -7.83753E-02 -5.22561E-02
- 6 -4.49423E-02 -7.66441E-02
-6 0 *********** SCCS-lys-phe
- 1 -2.83261E-01 -2.82225E-01
- 2 -4.67123E-02 -3.05368E-01
- 3 -1.24081E-01 -2.25716E-01
- 4 -1.34173E-01 9.75968E-02
- 5 -2.80280E-02 -6.88668E-02
- 6 -7.80157E-02 -1.83762E-01
-6 0 *********** SCCS-lys-ile
- 1 -2.84233E-01 -3.38287E-01
- 2 2.20427E-01 -2.64004E-01
- 3 -1.58959E-01 -1.44948E-01
- 4 -8.97810E-02 -2.09634E-02
- 5 -1.09463E-01 -5.26377E-02
- 6 -5.57165E-02 -7.68775E-02
-6 0 *********** SCCS-lys-leu
- 1 -2.73724E-01 -2.52138E-01
- 2 6.12377E-02 -5.58331E-01
- 3 -1.98930E-01 -1.72644E-01
- 4 -5.48866E-02 4.79222E-02
- 5 -1.99182E-01 -4.91883E-02
- 6 1.69523E-02 -1.37420E-02
-6 0 *********** SCCS-lys-val
- 1 -2.98627E-01 -2.75707E-01
- 2 1.14463E-01 -3.54748E-01
- 3 -1.16298E-01 -1.77887E-01
- 4 -1.24187E-01 -3.75858E-03
- 5 -6.11690E-02 -5.86659E-02
- 6 -8.37663E-02 -6.61661E-02
-6 0 *********** SCCS-lys-trp
- 1 -2.80578E-01 -3.21996E-01
- 2 1.02842E-01 -2.42915E-01
- 3 -1.59496E-01 -1.27884E-01
- 4 -4.35302E-02 3.72282E-02
- 5 -1.03763E-01 -3.99550E-02
- 6 -2.59685E-02 -9.79900E-02
-6 0 *********** SCCS-lys-tyr
- 1 -2.92728E-01 -2.88922E-01
- 2 -6.36405E-02 -2.53431E-01
- 3 -1.34377E-01 -2.37863E-01
- 4 -1.57029E-01 1.12814E-01
- 5 1.64142E-03 -8.43164E-02
- 6 -9.87544E-02 -2.32009E-01
-6 0 *********** SCCS-lys-ala
- 1 -2.69633E-01 -2.61400E-01
- 2 5.09753E-01 -2.71125E-01
- 3 -1.92565E-01 -3.68604E-02
- 4 3.87022E-02 -7.55745E-02
- 5 -2.01687E-01 -1.62476E-02
- 6 -2.79292E-03 6.32375E-02
-6 0 *********** SCCS-lys-gly
+4 0 *********** SCCS-arg-thr
+ 1 4.16188E-01 -3.96263E-02
+ 2 -3.05151E-02 -8.98761E-02
+ 3 -2.15470E-02 -1.76025E-02
+ 4 1.75198E-03 -2.62010E-02
+4 0 *********** SCCS-arg-ser
+ 1 5.40146E-01 1.60164E-01
+ 2 8.56227E-02 -9.98365E-02
+ 3 7.71265E-02 -9.15047E-02
+ 4 8.31182E-02 -6.66454E-03
+4 0 *********** SCCS-arg-gln
+ 1 4.17829E-01 -5.23332E-02
+ 2 -2.02148E-02 -7.96567E-02
+ 3 -1.86421E-02 -2.05454E-02
+ 4 -1.04838E-02 -2.17097E-02
+4 0 *********** SCCS-arg-asn
+ 1 4.80883E-01 2.07288E-01
+ 2 7.02761E-02 -8.66131E-02
+ 3 9.76470E-02 1.62622E-02
+ 4 1.65610E-02 4.60411E-02
+4 0 *********** SCCS-arg-glu
+ 1 4.40522E-01 -8.51300E-02
+ 2 -2.89210E-02 -8.43066E-02
+ 3 -3.20608E-02 -2.20732E-02
+ 4 -1.69003E-02 -2.84614E-02
+4 0 *********** SCCS-arg-asp
+ 1 5.04984E-01 2.16997E-01
+ 2 7.50359E-02 -7.60829E-02
+ 3 8.80974E-02 1.85290E-02
+ 4 2.88681E-02 5.98583E-02
+4 0 *********** SCCS-arg-his
+ 1 4.58552E-01 2.17691E-01
+ 2 7.71597E-02 -6.47595E-02
+ 3 7.36474E-02 3.91082E-02
+ 4 2.24069E-02 6.55631E-02
+4 0 *********** SCCS-arg-arg
+ 1 3.17884E-01 -1.55971E-01
+ 2 -6.93383E-02 -8.30403E-03
+ 3 -2.72502E-02 7.38191E-03
+ 4 -1.98515E-02 -8.58105E-03
+4 0 *********** SCCS-arg-lys
+ 1 2.94370E-01 -1.55508E-01
+ 2 -8.09118E-02 4.41482E-03
+ 3 -2.38380E-02 -4.36194E-04
+ 4 -2.67591E-02 -3.07623E-03
+4 0 *********** SCCS-arg-pro
+ 1 4.93755E-01 1.94671E-01
+ 2 1.71186E-01 -8.91925E-02
+ 3 6.69637E-02 -5.68402E-02
+ 4 9.32563E-02 2.49224E-02
+4 0 *********** SCCS-lys-cys
+ 1 5.93637E-01 1.04087E-01
+ 2 8.60939E-03 -2.48690E-01
+ 3 1.00929E-01 -3.66544E-02
+ 4 8.48823E-03 1.28443E-02
+4 0 *********** SCCS-lys-met
+ 1 4.19430E-01 -9.45382E-02
+ 2 -1.73812E-01 -5.18851E-02
+ 3 -1.23521E-02 -1.82211E-02
+ 4 1.71650E-02 7.00269E-03
+4 0 *********** SCCS-lys-phe
+ 1 4.05854E-01 -1.52236E-01
+ 2 -1.83981E-01 5.43363E-02
+ 3 -4.01237E-02 -2.99043E-02
+ 4 1.69326E-02 -1.75676E-02
+4 0 *********** SCCS-lys-ile
+ 1 5.11302E-01 -6.84253E-02
+ 2 -1.73310E-01 -1.33269E-01
+ 3 -7.38912E-03 -3.75648E-02
+ 4 1.06053E-02 1.21083E-02
+4 0 *********** SCCS-lys-leu
+ 1 3.68681E-01 -2.04273E-01
+ 2 -2.82440E-01 6.06387E-02
+ 3 -3.11424E-02 -2.11212E-02
+ 4 2.68833E-02 -6.60880E-03
+4 0 *********** SCCS-lys-val
+ 1 4.66384E-01 -1.32438E-01
+ 2 -2.51764E-01 -1.04951E-01
+ 3 -2.44270E-02 -4.50107E-02
+ 4 1.81820E-02 1.12568E-02
+4 0 *********** SCCS-lys-trp
+ 1 4.62284E-01 -1.11394E-01
+ 2 -1.27965E-01 -4.37476E-02
+ 3 -7.59629E-03 -2.61331E-02
+ 4 1.23499E-02 -8.34634E-03
+4 0 *********** SCCS-lys-tyr
+ 1 3.95190E-01 -1.53017E-01
+ 2 -1.61562E-01 6.64359E-02
+ 3 -4.03208E-02 -1.81493E-02
+ 4 1.39083E-02 -2.17163E-02
+4 0 *********** SCCS-lys-ala
+ 1 3.43197E-01 -5.33229E-03
+ 2 -2.45017E-01 -1.66817E-01
+ 3 1.80786E-02 1.62145E-02
+ 4 4.71477E-03 2.23686E-02
+4 0 *********** SCCS-lys-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-lys-thr
- 1 -2.90839E-01 -3.01780E-01
- 2 3.45888E-01 -2.72815E-01
- 3 -1.48629E-01 -1.99909E-01
- 4 -5.40208E-02 -5.49530E-02
- 5 -5.82159E-02 -9.93540E-02
- 6 -7.43989E-02 -1.05143E-01
-6 0 *********** SCCS-lys-ser
- 1 -8.25776E-01 -6.31593E-01
- 2 7.59627E-01 3.28957E-01
- 3 1.34157E-02 -2.09988E-01
- 4 4.36743E-02 1.02087E-01
- 5 8.17905E-02 -5.29487E-02
- 6 -2.39574E-02 -4.40762E-01
-6 0 *********** SCCS-lys-gln
- 1 -3.97538E-01 -3.51018E-01
- 2 3.38904E-01 -1.03188E-01
- 3 -9.98548E-02 -1.56287E-01
- 4 -4.66975E-02 2.61153E-02
- 5 -5.22992E-02 -1.01705E-02
- 6 -2.19686E-02 -1.31711E-01
-6 0 *********** SCCS-lys-asn
- 1 -2.92011E-01 -5.25603E-01
- 2 3.72446E-01 5.03649E-01
- 3 -1.88429E-01 -1.53145E-04
- 4 1.36891E-01 4.65355E-02
- 5 -1.33742E-01 -2.27972E-02
- 6 5.46336E-02 -3.02007E-01
-6 0 *********** SCCS-lys-glu
- 1 -4.29054E-01 -3.40848E-01
- 2 3.48874E-01 -2.09007E-01
- 3 -1.05801E-01 -1.80737E-01
- 4 -8.45434E-02 -1.27748E-02
- 5 -7.32634E-02 -2.29241E-02
- 6 -3.55994E-02 -9.07953E-02
-6 0 *********** SCCS-lys-asp
- 1 -2.27344E-01 -4.64711E-01
- 2 5.13038E-01 4.77924E-01
- 3 -4.04331E-02 -3.41223E-02
- 4 2.02068E-02 1.48085E-01
- 5 -1.19024E-02 1.14992E-03
- 6 -3.16690E-02 -3.54021E-01
-6 0 *********** SCCS-lys-his
- 1 -1.49143E-01 -5.24051E-01
- 2 1.98111E-01 4.53266E-01
- 3 -6.12044E-03 -1.14818E-02
- 4 1.01466E-03 5.76531E-02
- 5 -6.28890E-02 -3.65390E-02
- 6 -7.92853E-04 -3.18004E-01
-6 0 *********** SCCS-lys-arg
- 1 -3.03629E-01 -2.39692E-01
- 2 3.28980E-02 -2.90445E-01
- 3 -1.55706E-01 -1.52935E-01
- 4 -7.87916E-02 5.97098E-02
- 5 -7.05710E-02 -4.58845E-02
- 6 -4.80665E-02 -1.00015E-01
-6 0 *********** SCCS-lys-lys
- 1 -2.76500E-01 -2.42205E-01
- 2 7.30995E-02 -3.94309E-01
- 3 -1.70862E-01 -1.29827E-01
- 4 -7.24734E-02 4.28095E-02
- 5 -1.40274E-01 -4.73730E-02
- 6 -8.73447E-03 -4.24827E-02
-6 0 *********** SCCS-lys-pro
- 1 -9.29153E-01 3.28531E-01
- 2 1.20842E-01 1.74666E+00
- 3 -8.94476E-01 8.50019E-01
- 4 1.67985E-01 -4.61776E-01
- 5 -9.36941E-01 5.76112E-01
- 6 7.33976E-02 6.86464E-01
-6 0 *********** SCCS-pro-cys
- 1 -2.08039E-01 1.21242E+00
- 2 3.06994E-01 3.15833E-01
- 3 -9.60282E-02 -1.92386E-01
- 4 9.37223E-02 -3.03487E-02
- 5 4.63536E-02 -8.69181E-03
- 6 -2.21354E-02 1.06480E-02
-6 0 *********** SCCS-pro-met
- 1 1.04833E-01 8.25195E-01
- 2 -9.99227E-03 -4.62378E-04
- 3 -2.05661E-01 -2.57740E-01
- 4 -5.12431E-02 -4.52014E-02
- 5 -6.30400E-02 -7.27189E-02
- 6 -4.02912E-02 -2.62175E-02
-6 0 *********** SCCS-pro-phe
- 1 2.70293E-01 8.60724E-01
- 2 -1.37245E-01 5.36761E-02
- 3 -3.07777E-01 -1.89721E-01
- 4 -2.65210E-01 9.64549E-02
- 5 4.43643E-03 -1.08713E-01
- 6 -7.34776E-02 -1.31703E-01
-6 0 *********** SCCS-pro-ile
- 1 1.51217E-01 1.23188E+00
- 2 -3.47201E-01 5.30481E-02
- 3 -5.51084E-02 -5.07213E-01
- 4 1.80912E-01 -1.90149E-02
- 5 -3.42601E-02 6.89399E-02
- 6 -9.44818E-02 3.88992E-04
-6 0 *********** SCCS-pro-leu
- 1 3.12566E-01 8.81921E-01
- 2 -2.27749E-01 -1.52529E-01
- 3 -2.91043E-01 -5.41004E-01
- 4 -2.36405E-01 -3.33577E-02
- 5 -1.72140E-03 -9.79728E-02
- 6 -1.68694E-01 -1.34085E-01
-6 0 *********** SCCS-pro-val
- 1 1.37825E-01 1.13336E+00
- 2 -3.47931E-01 -1.59843E-01
- 3 -1.04634E-01 -5.16725E-01
- 4 2.59215E-01 9.79920E-03
- 5 -7.77016E-02 1.17339E-01
- 6 -8.13110E-02 6.41544E-02
-6 0 *********** SCCS-pro-trp
- 1 2.32812E-01 8.59238E-01
- 2 2.21764E-02 1.44317E-01
- 3 -2.76160E-01 -3.77822E-02
- 4 -1.32777E-01 4.76202E-02
- 5 -1.36190E-01 -4.92000E-02
- 6 -3.39862E-02 -5.74115E-04
-6 0 *********** SCCS-pro-tyr
- 1 3.42959E-01 8.37795E-01
- 2 -2.14038E-01 3.38815E-02
- 3 -3.01139E-01 -9.50215E-02
- 4 -1.91347E-01 4.68228E-02
- 5 -7.92888E-02 -8.98107E-02
- 6 -3.26324E-02 -2.88043E-02
-6 0 *********** SCCS-pro-ala
- 1 -5.17804E-01 8.80172E-01
- 2 -5.90859E-02 9.58266E-02
- 3 9.58777E-02 -6.83075E-01
- 4 -3.74253E-02 1.34935E-01
- 5 1.31650E-01 -5.64951E-02
- 6 -1.94414E-01 -3.63011E-01
-6 0 *********** SCCS-pro-gly
+4 0 *********** SCCS-lys-thr
+ 1 5.08714E-01 -7.02501E-02
+ 2 -1.65888E-01 -1.67768E-01
+ 3 -8.46236E-03 -4.49925E-02
+ 4 5.11848E-03 1.53504E-02
+4 0 *********** SCCS-lys-ser
+ 1 6.66779E-01 1.85446E-01
+ 2 1.05165E-01 -3.11994E-01
+ 3 1.85471E-01 -3.31472E-02
+ 4 2.66693E-02 8.10383E-03
+4 0 *********** SCCS-lys-gln
+ 1 5.14197E-01 -7.03192E-02
+ 2 -1.20402E-01 -1.49961E-01
+ 3 1.55007E-02 -6.07030E-02
+ 4 1.40581E-02 8.34558E-04
+4 0 *********** SCCS-lys-asn
+ 1 5.96174E-01 2.14942E-01
+ 2 1.61615E-01 -2.48920E-01
+ 3 9.87628E-02 5.68328E-02
+ 4 4.13750E-02 -1.46832E-02
+4 0 *********** SCCS-lys-glu
+ 1 5.42539E-01 -1.13554E-01
+ 2 -1.62501E-01 -1.45900E-01
+ 3 -2.64756E-03 -7.16020E-02
+ 4 1.43699E-02 -1.54648E-03
+4 0 *********** SCCS-lys-asp
+ 1 6.29323E-01 2.29069E-01
+ 2 1.65640E-01 -2.47336E-01
+ 3 1.15160E-01 4.80810E-02
+ 4 3.50094E-02 -6.00468E-03
+4 0 *********** SCCS-lys-his
+ 1 5.64122E-01 2.42482E-01
+ 2 1.81004E-01 -1.78154E-01
+ 3 5.88946E-02 7.53375E-02
+ 4 2.06019E-02 3.69907E-04
+4 0 *********** SCCS-lys-arg
+ 1 3.75256E-01 -1.84567E-01
+ 2 -1.80690E-01 3.21784E-02
+ 3 -2.70698E-02 -2.71976E-03
+ 4 1.32207E-02 -1.26064E-02
+4 0 *********** SCCS-lys-lys
+ 1 3.42418E-01 -1.84838E-01
+ 2 -2.23634E-01 3.89768E-02
+ 3 -3.39660E-02 4.62144E-03
+ 4 1.60552E-02 -8.28990E-04
+4 0 *********** SCCS-lys-pro
+ 1 7.37156E-01 2.16273E-01
+ 2 2.48115E-01 -3.27222E-01
+ 3 2.35046E-01 1.41540E-02
+ 4 6.93851E-02 7.56463E-03
+4 0 *********** SCCS-pro-cys
+ 1 1.13780E-02 -1.23190E+00
+ 2 4.30319E-01 -1.21847E-02
+ 3 -1.90232E-01 -7.70950E-02
+ 4 4.58235E-02 1.06327E-01
+4 0 *********** SCCS-pro-met
+ 1 -1.84507E-01 -7.35658E-01
+ 2 2.87352E-01 -2.79193E-01
+ 3 -1.81757E-01 8.84524E-03
+ 4 3.74601E-02 3.79035E-03
+4 0 *********** SCCS-pro-phe
+ 1 -1.14972E-01 -8.53847E-01
+ 2 5.74763E-02 -4.44151E-01
+ 3 -9.15213E-02 1.21792E-01
+ 4 2.42959E-02 2.01774E-03
+4 0 *********** SCCS-pro-ile
+ 1 -1.03687E-01 -9.86016E-01
+ 2 3.98442E-01 -3.27663E-01
+ 3 -2.79029E-01 -7.41475E-02
+ 4 4.12773E-02 2.16419E-02
+4 0 *********** SCCS-pro-leu
+ 1 -2.05953E-01 -6.91923E-01
+ 2 2.85752E-01 -6.85504E-01
+ 3 -1.60724E-01 1.19944E-01
+ 4 -6.45520E-02 -6.42387E-02
+4 0 *********** SCCS-pro-val
+ 1 -1.85155E-01 -8.48909E-01
+ 2 5.64419E-01 -3.99767E-01
+ 3 -3.07340E-01 -7.26555E-02
+ 4 6.37718E-02 -5.04584E-02
+4 0 *********** SCCS-pro-trp
+ 1 -1.72140E-01 -9.14169E-01
+ 2 1.95891E-02 -2.67473E-01
+ 3 -1.08564E-01 1.07980E-01
+ 4 7.27866E-02 1.27050E-02
+4 0 *********** SCCS-pro-tyr
+ 1 -1.28581E-01 -8.31327E-01
+ 2 4.68794E-02 -4.34261E-01
+ 3 -7.98146E-02 1.17122E-01
+ 4 2.02865E-02 1.46850E-02
+4 0 *********** SCCS-pro-ala
+ 1 2.45019E-01 -6.34920E-01
+ 2 6.31995E-01 -2.51828E-01
+ 3 -2.36710E-01 -9.32386E-02
+ 4 6.83390E-02 -2.85267E-02
+4 0 *********** SCCS-pro-gly
1 0.00000E+00 0.00000E+00
2 0.00000E+00 0.00000E+00
3 0.00000E+00 0.00000E+00
4 0.00000E+00 0.00000E+00
- 5 0.00000E+00 0.00000E+00
- 6 0.00000E+00 0.00000E+00
-6 0 *********** SCCS-pro-thr
- 1 -2.90835E-01 1.03511E+00
- 2 9.07091E-02 -2.83168E-01
- 3 -2.87597E-02 -2.42029E-01
- 4 2.48563E-01 4.41896E-02
- 5 -1.77640E-01 -4.81394E-02
- 6 3.81724E-02 7.39471E-02
-6 0 *********** SCCS-pro-ser
- 1 -3.15844E-01 1.68188E+00
- 2 8.27872E-01 3.80557E-01
- 3 -7.21911E-02 -1.19022E-01
- 4 2.94318E-01 9.27714E-02
- 5 3.84365E-02 -2.09315E-02
- 6 7.72261E-02 9.45871E-03
-6 0 *********** SCCS-pro-gln
- 1 -2.75595E-02 8.83986E-01
- 2 2.36514E-01 1.47014E-01
- 3 -2.71493E-01 -3.81209E-02
- 4 -4.63320E-02 -3.35956E-02
- 5 -5.64537E-02 -5.20119E-02
- 6 -1.31085E-02 5.80492E-02
-6 0 *********** SCCS-pro-asn
- 1 -7.64678E-01 8.48582E-01
- 2 1.44172E-01 5.12018E-01
- 3 -1.79457E-01 1.75001E-01
- 4 -1.42279E-01 1.95035E-01
- 5 -1.67567E-02 -1.32361E-02
- 6 -1.22373E-01 -8.76012E-02
-6 0 *********** SCCS-pro-glu
- 1 1.47617E-01 9.96891E-01
- 2 1.90086E-01 7.19053E-02
- 3 -2.38637E-01 -1.17586E-01
- 4 -5.55263E-02 -5.42835E-02
- 5 -8.04241E-02 -8.03232E-02
- 6 -1.07862E-02 4.99726E-02
-6 0 *********** SCCS-pro-asp
- 1 -1.29479E+00 6.36999E-01
- 2 3.87774E-01 3.58834E-01
- 3 -5.17997E-03 -1.49297E-03
- 4 3.93598E-02 1.48663E-01
- 5 2.01961E-02 -7.51423E-02
- 6 -3.79656E-03 -1.84407E-01
-6 0 *********** SCCS-pro-his
- 1 -3.34426E-01 1.19670E+00
- 2 -1.56739E-01 6.71080E-01
- 3 -2.46508E-01 2.22064E-01
- 4 -7.34581E-02 4.85451E-02
- 5 -9.69955E-02 -6.11139E-02
- 6 -2.03358E-02 -1.00268E-03
-6 0 *********** SCCS-pro-arg
- 1 1.96339E-01 6.67428E-01
- 2 -5.06552E-02 -3.32739E-02
- 3 -2.64246E-01 -1.90599E-01
- 4 -3.57824E-02 -3.40898E-02
- 5 -8.82477E-02 -6.04958E-02
- 6 -1.05153E-02 -5.70527E-03
-6 0 *********** SCCS-pro-lys
- 1 2.17931E-01 7.40442E-01
- 2 -1.60154E-01 -9.55101E-02
- 3 -2.22489E-01 -3.79800E-01
- 4 -1.18440E-01 -4.33765E-02
- 5 -4.07279E-02 -5.14164E-02
- 6 -9.95895E-02 -5.20337E-02
-6 0 *********** SCCS-pro-pro
- 1 5.03922E+01 -1.54518E+01
- 2 -2.23454E+01 1.61095E+01
- 3 -1.41391E+00 -1.79688E+00
- 4 8.36846E+00 -1.29971E+01
- 5 -2.80579E+00 1.36547E+01
- 6 -7.40840E-01 1.14019E+01
+4 0 *********** SCCS-pro-thr
+ 1 -1.19482E-01 -9.21813E-01
+ 2 3.95093E-01 -2.48604E-01
+ 3 -2.12446E-01 -1.08968E-01
+ 4 3.51352E-02 4.08504E-02
+4 0 *********** SCCS-pro-ser
+ 1 9.66746E-02 -1.87464E+00
+ 2 3.34680E-01 3.71959E-01
+ 3 -1.74631E-02 -1.24877E-01
+ 4 -7.73451E-02 9.44713E-02
+4 0 *********** SCCS-pro-gln
+ 1 -1.92023E-01 -9.29464E-01
+ 2 2.35227E-01 -6.67535E-02
+ 3 -5.85362E-02 4.72724E-03
+ 4 9.18944E-02 4.08748E-02
+4 0 *********** SCCS-pro-asn
+ 1 3.87595E-01 -1.23464E+00
+ 2 2.12310E-02 4.88199E-01
+ 3 7.85162E-02 -6.75623E-02
+ 4 -3.44742E-03 4.76528E-02
+4 0 *********** SCCS-pro-glu
+ 1 -2.83068E-01 -1.01776E+00
+ 2 2.88416E-01 -2.00060E-01
+ 3 -1.28540E-01 4.60875E-03
+ 4 1.04337E-01 1.33568E-02
+4 0 *********** SCCS-pro-asp
+ 1 5.38418E-01 -1.43528E+00
+ 2 1.54838E-02 4.69489E-01
+ 3 1.64083E-01 -7.46719E-02
+ 4 -4.17517E-03 1.51138E-02
+4 0 *********** SCCS-pro-his
+ 1 4.45082E-01 -1.23950E+00
+ 2 -1.94661E-01 2.57807E-01
+ 3 -1.00110E-01 -6.75693E-02
+ 4 -7.17474E-02 5.71482E-02
+4 0 *********** SCCS-pro-arg
+ 1 -2.70182E-01 -6.77603E-01
+ 2 1.11620E-01 -3.38473E-01
+ 3 -1.12996E-01 9.27559E-02
+ 4 1.13361E-02 -5.10264E-03
+4 0 *********** SCCS-pro-lys
+ 1 -3.12404E-01 -5.56698E-01
+ 2 2.96887E-01 -4.31599E-01
+ 3 -1.84841E-01 2.85067E-02
+ 4 1.47292E-02 -1.92123E-02
+4 0 *********** SCCS-pro-pro
+ 1 4.75981E-01 -3.04401E+00
+ 2 1.03330E-01 2.29809E-01
+ 3 -2.61299E-01 -3.79309E-01
+ 4 -2.52541E-01 6.54833E-01
--- /dev/null
+Makefile_4P
\ No newline at end of file
CFLAGS = -DLINUX -DPGI -c
-OPT = -O
-#OPT1 = -fbounds-check -g -O
+#OPT = -O
+OPT1 = -fbounds-check -g -O
-#OPT = -fbounds-check -g
-OPT1 = -g
+OPT = -fbounds-check -g
+#OPT1 = -g
# -Mvect <---slows down
# -Minline=name:matmat2 <---false convergence
include 'COMMON.CONTROL'
include 'COMMON.DISTFIT'
include 'COMMON.SETUP'
- character*3 seq,atom,res
- character*80 card
- dimension sccor(3,20)
+ integer i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity,
+ & ishift_pdb
+ logical lprn /.true./,fail
double precision e1(3),e2(3),e3(3)
- logical fail
+ double precision dcj,efree_temp
+ character*3 seq,res
+ character*5 atom
+ character*80 card
+ double precision sccor(3,20)
integer rescode
+ efree_temp=0.0d0
ibeg=1
+ ishift1=0
+ ishift=0
+c write (2,*) "UNRES_PDB",unres_pdb
+ ires=0
+ ires_old=0
+ iii=0
lsecondary=.false.
nhfrag=0
nbfrag=0
- do i=1,maxres
- itype(i)=21
- do j=1,3
- c(j,i)=0.0d0
- c(j,i+nres)=0.0d0
- enddo
- enddo
do i=1,10000
read (ipdbin,'(a80)',end=10) card
+c write (iout,'(a)') card
if (card(:5).eq.'HELIX') then
nhfrag=nhfrag+1
lsecondary=.true.
crc----------------------------------------
endif
if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10
+c Read free energy
+ if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp
C Fish out the ATOM cards.
if (index(card(1:4),'ATOM').gt.0) then
- read (card(14:16),'(a3)') atom
- if (atom.eq.'CA' .or. atom.eq.'CH3') then
+ read (card(12:16),*) atom
+c write (iout,*) "! ",atom," !",ires
+c if (atom.eq.'CA' .or. atom.eq.'CH3') then
+ read (card(23:26),*) ires
+ read (card(18:20),'(a3)') res
+c write (iout,*) "ires",ires,ires-ishift+ishift1,
+c & " ires_old",ires_old
+c write (iout,*) "ishift",ishift," ishift1",ishift1
+c write (iout,*) "IRES",ires-ishift+ishift1,ires_old
+ if (ires-ishift+ishift1.ne.ires_old) then
C Calculate the CM of the preceding residue.
+c if (ibeg.eq.0) call sccenter(ires,iii,sccor)
if (ibeg.eq.0) then
+c write (iout,*) "Calculating sidechain center iii",iii
if (unres_pdb) then
do j=1,3
- dc(j,ires+nres)=sccor(j,iii)
+ dc(j,ires)=sccor(j,iii)
enddo
else
- call sccenter(ires,iii,sccor)
+ call sccenter(ires_old,iii,sccor)
endif
+ iii=0
endif
C Start new residue.
- read (card(24:26),*) ires
- read (card(18:20),'(a3)') res
- if (ibeg.eq.1) then
+ if (res.eq.'Cl-' .or. res.eq.'Na+') then
+ ires=ires_old
+ cycle
+ else if (ibeg.eq.1) then
+c write (iout,*) "BEG ires",ires
ishift=ires-1
if (res.ne.'GLY' .and. res.ne. 'ACE') then
ishift=ishift-1
itype(1)=21
endif
+ ires=ires-ishift+ishift1
+ ires_old=ires
+c write (iout,*) "ishift",ishift," ires",ires,
+c & " ires_old",ires_old
ibeg=0
+ else
+ ishift=ishift-(ires-ishift+ishift1-ires_old-1)
+ ires=ires-ishift+ishift1
+ ires_old=ires
endif
- ires=ires-ishift
- if (res.eq.'ACE') then
- ity=10
+ if (res.eq.'ACE' .or. res.eq.'NHE') then
+ itype(ires)=10
else
itype(ires)=rescode(ires,res,0)
endif
+ else
+ ires=ires-ishift+ishift1
+ endif
+c write (iout,*) "ires_old",ires_old," ires",ires
+ if (card(27:27).eq."A" .or. card(27:27).eq."B") then
+c ishift1=ishift1+1
+ endif
+c write (2,*) "ires",ires," res ",res," ity",ity
+ if (atom.eq.'CA' .or. atom.eq.'CH3' .or.
+ & res.eq.'NHE'.and.atom(:2).eq.'HN') then
read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
-c if(me.eq.king.or..not.out1file)
-c & write (iout,'(2i3,2x,a,3f8.3)')
-c & ires,itype(ires),res,(c(j,ires),j=1,3)
- iii=1
+c write (iout,*) "backbone ",atom
+#ifdef DEBUG
+ write (iout,'(2i3,2x,a,3f8.3)')
+ & ires,itype(ires),res,(c(j,ires),j=1,3)
+#endif
+ iii=iii+1
do j=1,3
sccor(j,iii)=c(j,ires)
enddo
- else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and.
- & atom.ne.'N ' .and. atom.ne.'C ') then
+ if (ishift.ne.0) then
+ ires_ca=ires+ishift-ishift1
+ else
+ ires_ca=ires
+ endif
+c write (*,*) card(23:27),ires,itype(ires)
+ else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and.
+ & atom.ne.'N' .and. atom.ne.'C' .and.
+ & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and.
+ & atom.ne.'OXT' .and. atom(:2).ne.'3H') then
+c write (iout,*) "sidechain ",atom
iii=iii+1
read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
endif
endif
enddo
- 10 if(me.eq.king.or..not.out1file)
- & write (iout,'(a,i5)') ' Nres: ',ires
+ 10 write (iout,'(a,i5)') ' Number of residues found: ',ires
+ if (ires.eq.0) return
C Calculate the CM of the last side chain.
+ if (iii.gt.0) then
if (unres_pdb) then
do j=1,3
- dc(j,ires+nres)=sccor(j,iii)
+ dc(j,ires)=sccor(j,iii)
enddo
- else if (.not.catrace) then
+ else
call sccenter(ires,iii,sccor)
endif
+ endif
nres=ires
nsup=nres
nstart_sup=1
if (itype(nres).ne.10) then
nres=nres+1
itype(nres)=21
- if (unres_pdb) then
-C 2/15/2013 by Adam: corrected insertion of the last dummy residue
- call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail)
- if (fail) then
- e2(1)=0.0d0
- e2(2)=1.0d0
- e2(3)=0.0d0
- endif
- do j=1,3
- c(j,nres)=c(j,nres-1)-3.8d0*e2(j)
- enddo
- else if (.not.catrace) then
do j=1,3
dcj=c(j,nres-2)-c(j,nres-3)
c(j,nres)=c(j,nres-1)+dcj
c(j,2*nres)=c(j,nres)
enddo
- endif
endif
do i=2,nres-1
do j=1,3
do j=1,3
c(j,1)=c(j,2)-3.8d0*e2(j)
enddo
- else if (.not.catrace) then
+ else
do j=1,3
dcj=c(j,4)-c(j,3)
c(j,1)=c(j,2)-dcj
enddo
endif
endif
+C Copy the coordinates to reference coordinates
+c do i=1,2*nres
+c do j=1,3
+c cref(j,i)=c(j,i)
+c enddo
+c enddo
+C Calculate internal coordinates.
+ if (lprn) then
+ write (iout,'(/a)')
+ & "Cartesian coordinates of the reference structure"
+ write (iout,'(a,3(3x,a5),5x,3(3x,a5))')
+ & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)"
+ do ires=1,nres
+ write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)')
+ & restyp(itype(ires)),ires,(c(j,ires),j=1,3),
+ & (c(j,ires+nres),j=1,3)
+ enddo
+ endif
C Calculate internal coordinates.
if(me.eq.king.or..not.out1file)then
write (iout,'(a)')
& (c(j,nres+ires),j=1,3)
enddo
endif
- call int_from_cart(.not.catrace,.false.)
- if (.not.catrace) call sc_loc_geom(.false.)
+ call int_from_cart(.true.,.false.)
+ call sc_loc_geom(.false.)
do i=1,nres
thetaref(i)=theta(i)
phiref(i)=phi(i)
hfrag(i,j)=hfrag(i,j)-ishift
enddo
enddo
-
+ ishift_pdb=ishift
return
end
c---------------------------------------------------------------------------
include 'COMMON.NAMES'
include 'COMMON.CONTROL'
include 'COMMON.SETUP'
- character*3 seq,atom,res
+ character*3 seq,res
+c character*5 atom
character*80 card
dimension sccor(3,20)
integer rescode
endif
endif
do i=1,nres-1
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
iti=itype(i)
if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then
write (iout,'(a,i4)') 'Bad Cartesians for residue',i
c endif
if (lside) then
do i=2,nres-1
- if (itype(i).eq.ntyp1) cycle
do j=1,3
c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i)
& +(c(j,i+1)-c(j,i))*vbld_inv(i+1))
iti=itype(i)
di=dist(i,nres+i)
C 10/03/12 Adam: Correction for zero SC-SC bond length
- if (itype(i).ne.10 .and. itype(i).ne.ntyp1. and. di.eq.0.0d0)
+ if (itype(i).ne.10 .and. itype(i).ne.21. and. di.eq.0.0d0)
& di=dsc(itype(i))
vbld(i+nres)=di
if (itype(i).ne.10) then
--- /dev/null
+ subroutine readpdb
+C Read the PDB file and convert the peptide geometry into virtual-chain
+C geometry.
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.LOCAL'
+ include 'COMMON.VAR'
+ include 'COMMON.CHAIN'
+ include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.GEO'
+ include 'COMMON.NAMES'
+ include 'COMMON.CONTROL'
+ include 'COMMON.DISTFIT'
+ include 'COMMON.SETUP'
+ character*3 seq,atom,res
+ character*80 card
+ dimension sccor(3,20)
+ double precision e1(3),e2(3),e3(3)
+ logical fail
+ integer rescode
+ ibeg=1
+ lsecondary=.false.
+ nhfrag=0
+ nbfrag=0
+ do i=1,maxres
+ itype(i)=21
+ do j=1,3
+ c(j,i)=0.0d0
+ c(j,i+nres)=0.0d0
+ enddo
+ enddo
+ do i=1,10000
+ read (ipdbin,'(a80)',end=10) card
+ if (card(:5).eq.'HELIX') then
+ nhfrag=nhfrag+1
+ lsecondary=.true.
+ read(card(22:25),*) hfrag(1,nhfrag)
+ read(card(34:37),*) hfrag(2,nhfrag)
+ endif
+ if (card(:5).eq.'SHEET') then
+ nbfrag=nbfrag+1
+ lsecondary=.true.
+ read(card(24:26),*) bfrag(1,nbfrag)
+ read(card(35:37),*) bfrag(2,nbfrag)
+crc----------------------------------------
+crc to be corrected !!!
+ bfrag(3,nbfrag)=bfrag(1,nbfrag)
+ bfrag(4,nbfrag)=bfrag(2,nbfrag)
+crc----------------------------------------
+ endif
+ if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10
+C Fish out the ATOM cards.
+ if (index(card(1:4),'ATOM').gt.0) then
+ read (card(14:16),'(a3)') atom
+ if (atom.eq.'CA' .or. atom.eq.'CH3') then
+C Calculate the CM of the preceding residue.
+ if (ibeg.eq.0) then
+ if (unres_pdb) then
+ do j=1,3
+ dc(j,ires+nres)=sccor(j,iii)
+ enddo
+ else
+ call sccenter(ires,iii,sccor)
+ endif
+ endif
+C Start new residue.
+ read (card(24:26),*) ires
+ read (card(18:20),'(a3)') res
+ if (ibeg.eq.1) then
+ ishift=ires-1
+ if (res.ne.'GLY' .and. res.ne. 'ACE') then
+ ishift=ishift-1
+ itype(1)=21
+ endif
+ ibeg=0
+ endif
+ ires=ires-ishift
+ if (res.eq.'ACE') then
+ ity=10
+ else
+ itype(ires)=rescode(ires,res,0)
+ endif
+ read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
+c if(me.eq.king.or..not.out1file)
+c & write (iout,'(2i3,2x,a,3f8.3)')
+c & ires,itype(ires),res,(c(j,ires),j=1,3)
+ iii=1
+ do j=1,3
+ sccor(j,iii)=c(j,ires)
+ enddo
+ else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and.
+ & atom.ne.'N ' .and. atom.ne.'C ') then
+ iii=iii+1
+ read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
+ endif
+ endif
+ enddo
+ 10 if(me.eq.king.or..not.out1file)
+ & write (iout,'(a,i5)') ' Nres: ',ires
+C Calculate the CM of the last side chain.
+ if (unres_pdb) then
+ do j=1,3
+ dc(j,ires+nres)=sccor(j,iii)
+ enddo
+ else if (.not.catrace) then
+ call sccenter(ires,iii,sccor)
+ endif
+ nres=ires
+ nsup=nres
+ nstart_sup=1
+ if (itype(nres).ne.10) then
+ nres=nres+1
+ itype(nres)=21
+ if (unres_pdb) then
+C 2/15/2013 by Adam: corrected insertion of the last dummy residue
+ call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail)
+ if (fail) then
+ e2(1)=0.0d0
+ e2(2)=1.0d0
+ e2(3)=0.0d0
+ endif
+ do j=1,3
+ c(j,nres)=c(j,nres-1)-3.8d0*e2(j)
+ enddo
+ else if (.not.catrace) then
+ do j=1,3
+ dcj=c(j,nres-2)-c(j,nres-3)
+ c(j,nres)=c(j,nres-1)+dcj
+ c(j,2*nres)=c(j,nres)
+ enddo
+ endif
+ endif
+ do i=2,nres-1
+ do j=1,3
+ c(j,i+nres)=dc(j,i)
+ enddo
+ enddo
+ do j=1,3
+ c(j,nres+1)=c(j,1)
+ c(j,2*nres)=c(j,nres)
+ enddo
+ if (itype(1).eq.21) then
+ nsup=nsup-1
+ nstart_sup=2
+ if (unres_pdb) then
+C 2/15/2013 by Adam: corrected insertion of the first dummy residue
+ call refsys(2,3,4,e1,e2,e3,fail)
+ if (fail) then
+ e2(1)=0.0d0
+ e2(2)=1.0d0
+ e2(3)=0.0d0
+ endif
+ do j=1,3
+ c(j,1)=c(j,2)-3.8d0*e2(j)
+ enddo
+ else if (.not.catrace) then
+ do j=1,3
+ dcj=c(j,4)-c(j,3)
+ c(j,1)=c(j,2)-dcj
+ c(j,nres+1)=c(j,1)
+ enddo
+ endif
+ endif
+C Calculate internal coordinates.
+ if(me.eq.king.or..not.out1file)then
+ write (iout,'(a)')
+ & "Backbone and SC coordinates as read from the PDB"
+ do ires=1,nres
+ write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)')
+ & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3),
+ & (c(j,nres+ires),j=1,3)
+ enddo
+ endif
+ call int_from_cart(.not.catrace,.false.)
+ if (.not.catrace) call sc_loc_geom(.false.)
+ do i=1,nres
+ thetaref(i)=theta(i)
+ phiref(i)=phi(i)
+ enddo
+ do i=1,nres-1
+ do j=1,3
+ dc(j,i)=c(j,i+1)-c(j,i)
+ dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
+ enddo
+ enddo
+ do i=2,nres-1
+ do j=1,3
+ dc(j,i+nres)=c(j,i+nres)-c(j,i)
+ dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
+ enddo
+c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3),
+c & vbld_inv(i+nres)
+ enddo
+c call chainbuild
+C Copy the coordinates to reference coordinates
+ do i=1,2*nres
+ do j=1,3
+ cref(j,i)=c(j,i)
+ enddo
+ enddo
+
+
+ do j=1,nbfrag
+ do i=1,4
+ bfrag(i,j)=bfrag(i,j)-ishift
+ enddo
+ enddo
+
+ do j=1,nhfrag
+ do i=1,2
+ hfrag(i,j)=hfrag(i,j)-ishift
+ enddo
+ enddo
+
+ return
+ end
+c---------------------------------------------------------------------------
+ subroutine int_from_cart(lside,lprn)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+#ifdef MPI
+ include "mpif.h"
+#endif
+ include 'COMMON.LOCAL'
+ include 'COMMON.VAR'
+ include 'COMMON.CHAIN'
+ include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.GEO'
+ include 'COMMON.NAMES'
+ include 'COMMON.CONTROL'
+ include 'COMMON.SETUP'
+ character*3 seq,atom,res
+ character*80 card
+ dimension sccor(3,20)
+ integer rescode
+ logical lside,lprn
+ if(me.eq.king.or..not.out1file)then
+ if (lprn) then
+ write (iout,'(/a)')
+ & 'Internal coordinates calculated from crystal structure.'
+ if (lside) then
+ write (iout,'(8a)') ' Res ',' dvb',' Theta',
+ & ' Gamma',' Dsc_id',' Dsc',' Alpha',
+ & ' Beta '
+ else
+ write (iout,'(4a)') ' Res ',' dvb',' Theta',
+ & ' Gamma'
+ endif
+ endif
+ endif
+ do i=1,nres-1
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
+ iti=itype(i)
+ if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then
+ write (iout,'(a,i4)') 'Bad Cartesians for residue',i
+ctest stop
+ endif
+ vbld(i+1)=dist(i,i+1)
+ vbld_inv(i+1)=1.0d0/vbld(i+1)
+ if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1)
+ if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1)
+ enddo
+c if (unres_pdb) then
+c if (itype(1).eq.21) then
+c theta(3)=90.0d0*deg2rad
+c phi(4)=180.0d0*deg2rad
+c vbld(2)=3.8d0
+c vbld_inv(2)=1.0d0/vbld(2)
+c endif
+c if (itype(nres).eq.21) then
+c theta(nres)=90.0d0*deg2rad
+c phi(nres)=180.0d0*deg2rad
+c vbld(nres)=3.8d0
+c vbld_inv(nres)=1.0d0/vbld(2)
+c endif
+c endif
+ if (lside) then
+ do i=2,nres-1
+ if (itype(i).eq.ntyp1) cycle
+ do j=1,3
+ c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i)
+ & +(c(j,i+1)-c(j,i))*vbld_inv(i+1))
+ enddo
+ iti=itype(i)
+ di=dist(i,nres+i)
+C 10/03/12 Adam: Correction for zero SC-SC bond length
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1. and. di.eq.0.0d0)
+ & di=dsc(itype(i))
+ vbld(i+nres)=di
+ if (itype(i).ne.10) then
+ vbld_inv(i+nres)=1.0d0/di
+ else
+ vbld_inv(i+nres)=0.0d0
+ endif
+ if (iti.ne.10) then
+ alph(i)=alpha(nres+i,i,maxres2)
+ omeg(i)=beta(nres+i,i,maxres2,i+1)
+ endif
+ if(me.eq.king.or..not.out1file)then
+ if (lprn)
+ & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i),
+ & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i),
+ & rad2deg*alph(i),rad2deg*omeg(i)
+ endif
+ enddo
+ else if (lprn) then
+ do i=2,nres
+ iti=itype(i)
+ if(me.eq.king.or..not.out1file)
+ & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1),
+ & rad2deg*theta(i),rad2deg*phi(i)
+ enddo
+ endif
+ return
+ end
+c-------------------------------------------------------------------------------
+ subroutine sc_loc_geom(lprn)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+#ifdef MPI
+ include "mpif.h"
+#endif
+ include 'COMMON.LOCAL'
+ include 'COMMON.VAR'
+ include 'COMMON.CHAIN'
+ include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
+ include 'COMMON.GEO'
+ include 'COMMON.NAMES'
+ include 'COMMON.CONTROL'
+ include 'COMMON.SETUP'
+ double precision x_prime(3),y_prime(3),z_prime(3)
+ logical lprn
+ do i=1,nres-1
+ do j=1,3
+ dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i))
+ enddo
+ enddo
+ do i=2,nres-1
+ if (itype(i).ne.10) then
+ do j=1,3
+ dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i))
+ enddo
+ else
+ do j=1,3
+ dc_norm(j,i+nres)=0.0d0
+ enddo
+ endif
+ enddo
+ do i=2,nres-1
+ costtab(i+1) =dcos(theta(i+1))
+ sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
+ cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
+ sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
+ cosfac2=0.5d0/(1.0d0+costtab(i+1))
+ cosfac=dsqrt(cosfac2)
+ sinfac2=0.5d0/(1.0d0-costtab(i+1))
+ sinfac=dsqrt(sinfac2)
+ it=itype(i)
+ if (it.ne.10) then
+c
+C Compute the axes of tghe local cartesian coordinates system; store in
+c x_prime, y_prime and z_prime
+c
+ do j=1,3
+ x_prime(j) = 0.00
+ y_prime(j) = 0.00
+ z_prime(j) = 0.00
+ enddo
+ do j = 1,3
+ x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
+ y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
+ enddo
+ call vecpr(x_prime,y_prime,z_prime)
+c
+C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
+C to local coordinate system. Store in xx, yy, zz.
+c
+ xx=0.0d0
+ yy=0.0d0
+ zz=0.0d0
+ do j = 1,3
+ xx = xx + x_prime(j)*dc_norm(j,i+nres)
+ yy = yy + y_prime(j)*dc_norm(j,i+nres)
+ zz = zz + z_prime(j)*dc_norm(j,i+nres)
+ enddo
+
+ xxref(i)=xx
+ yyref(i)=yy
+ zzref(i)=zz
+ else
+ xxref(i)=0.0d0
+ yyref(i)=0.0d0
+ zzref(i)=0.0d0
+ endif
+ enddo
+ if (lprn) then
+ do i=2,nres
+ iti=itype(i)
+ if(me.eq.king.or..not.out1file)
+ & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),
+ & yyref(i),zzref(i)
+ enddo
+ endif
+ return
+ end
+c---------------------------------------------------------------------------
+ subroutine sccenter(ires,nscat,sccor)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.CHAIN'
+ dimension sccor(3,20)
+ do j=1,3
+ sccmj=0.0D0
+ do i=1,nscat
+ sccmj=sccmj+sccor(j,i)
+ enddo
+ dc(j,ires)=sccmj/nscat
+ enddo
+ return
+ end
+c---------------------------------------------------------------------------
+ subroutine bond_regular
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.VAR'
+ include 'COMMON.LOCAL'
+ include 'COMMON.CALC'
+ include 'COMMON.INTERACT'
+ include 'COMMON.CHAIN'
+ do i=1,nres-1
+ vbld(i+1)=vbl
+ vbld_inv(i+1)=1.0d0/vbld(i+1)
+ vbld(i+1+nres)=dsc(itype(i+1))
+ vbld_inv(i+1+nres)=dsc_inv(itype(i+1))
+c print *,vbld(i+1),vbld(i+1+nres)
+ enddo
+ return
+ end
enddo
endif
#endif
- call mpi_scatter(i2set,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
+c Corrected AL 8/19/2014: each processor needs whole iset array not only its
+c own element
+c call mpi_scatter(i2set,1,mpi_integer,
+c & iset,1,mpi_integer,king,
+c & CG_COMM,ierr)
+ call mpi_bcast(i2set(0),nodes,mpi_integer,king,
+ & CG_COMM,ierr)
+ iset=i2set(me)
endif
enddo
endif
#endif
- call mpi_scatter(i2set,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
+c Corrected AL 8/19/2014: each processor needs whole iset array not only its
+c own element
+c call mpi_scatter(i2set,1,mpi_integer,
+c & iset,1,mpi_integer,king,
+c & CG_COMM,ierr)
+ call mpi_bcast(i2set(0),nodes,mpi_integer,king,
+ & CG_COMM,ierr)
+ iset=i2set(me)
endif
enddo
endif
#endif
- call mpi_scatter(i2set,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
+c Corrected AL 8/19/2014: each processor needs whole iset array not only its
+c own element
+c call mpi_scatter(i2set,1,mpi_integer,
+c & iset,1,mpi_integer,king,
+c & CG_COMM,ierr)
+ call mpi_bcast(i2set(0),nodes,mpi_integer,king,
+ & CG_COMM,ierr)
+ iset=i2set(me)
endif
include 'COMMON.CONTROL'
include 'COMMON.DISTFIT'
include 'COMMON.SETUP'
- character*3 seq,atom,res
- character*80 card
- dimension sccor(3,20)
+ integer i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity,
+ & ishift_pdb
+ logical lprn /.true./,fail
double precision e1(3),e2(3),e3(3)
+ double precision dcj,efree_temp
+ character*3 seq,res
+ character*5 atom
+ character*80 card
+ double precision sccor(3,20)
integer rescode
- logical fail
+ efree_temp=0.0d0
ibeg=1
+ ishift1=0
+ ishift=0
+c write (2,*) "UNRES_PDB",unres_pdb
+ ires=0
+ ires_old=0
+ nres=0
+ iii=0
lsecondary=.false.
nhfrag=0
nbfrag=0
- do
+ do i=1,100000
read (ipdbin,'(a80)',end=10) card
+c write (iout,'(a)') card
if (card(:5).eq.'HELIX') then
nhfrag=nhfrag+1
lsecondary=.true.
goto 10
else if (card(:3).eq.'TER') then
C End current chain
- ires_old=ires+1
- itype(ires_old)=21
+ ires_old=ires+1
+ ishift1=ishift1+1
+ itype(ires_old)=ntyp1
ibeg=2
c write (iout,*) "Chain ended",ires,ishift,ires_old
if (unres_pdb) then
do j=1,3
dc(j,ires)=sccor(j,iii)
enddo
- else
+ else
call sccenter(ires,iii,sccor)
endif
+ iii=0
endif
+c Read free energy
+ if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp
C Fish out the ATOM cards.
if (index(card(1:4),'ATOM').gt.0) then
- read (card(14:16),'(a3)') atom
- if (atom.eq.'CA' .or. atom.eq.'CH3') then
+ read (card(12:16),*) atom
+c write (iout,*) "! ",atom," !",ires
+c if (atom.eq.'CA' .or. atom.eq.'CH3') then
+ read (card(23:26),*) ires
+ read (card(18:20),'(a3)') res
+c write (iout,*) "ires",ires,ires-ishift+ishift1,
+c & " ires_old",ires_old
+c write (iout,*) "ishift",ishift," ishift1",ishift1
+c write (iout,*) "IRES",ires-ishift+ishift1,ires_old
+ if (ires-ishift+ishift1.ne.ires_old) then
C Calculate the CM of the preceding residue.
+c if (ibeg.eq.0) call sccenter(ires,iii,sccor)
if (ibeg.eq.0) then
+c write (iout,*) "Calculating sidechain center iii",iii
if (unres_pdb) then
do j=1,3
dc(j,ires+nres)=sccor(j,iii)
enddo
else
- call sccenter(ires,iii,sccor)
+ call sccenter(ires_old,iii,sccor)
endif
+ iii=0
endif
C Start new residue.
-c write (iout,'(a80)') card
- read (card(24:26),*) ires
- read (card(18:20),'(a3)') res
- if (ibeg.eq.1) then
+ if (res.eq.'Cl-' .or. res.eq.'Na+') then
+ ires=ires_old
+ cycle
+ else if (ibeg.eq.1) then
+c write (iout,*) "BEG ires",ires
ishift=ires-1
if (res.ne.'GLY' .and. res.ne. 'ACE') then
ishift=ishift-1
- itype(1)=21
+ itype(1)=ntyp1
endif
-c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift
- ibeg=0
+ ires=ires-ishift+ishift1
+ ires_old=ires
+c write (iout,*) "ishift",ishift," ires",ires,
+c & " ires_old",ires_old
+ ibeg=0
else if (ibeg.eq.2) then
c Start a new chain
- ishift=-ires_old+ires-1
-c write (iout,*) "New chain started",ires,ishift
+c ishift=-ires_old+ires-1
+c ishift1=ishift1+1
+c write (iout,*) "New chain started",ires,ishift,ishift1,"!"
+ ires=ires-ishift+ishift1
+ ires_old=ires
ibeg=0
+ else
+ ishift=ishift-(ires-ishift+ishift1-ires_old-1)
+ ires=ires-ishift+ishift1
+ ires_old=ires
endif
- ires=ires-ishift
-c write (2,*) "ires",ires," ishift",ishift
- if (res.eq.'ACE') then
- ity=10
+ if (res.eq.'ACE' .or. res.eq.'NHE') then
+ itype(ires)=10
else
itype(ires)=rescode(ires,res,0)
endif
+ else
+ ires=ires-ishift+ishift1
+ endif
+c write (iout,*) "ires_old",ires_old," ires",ires
+ if (card(27:27).eq."A" .or. card(27:27).eq."B") then
+c ishift1=ishift1+1
+ endif
+c write (2,*) "ires",ires," res ",res," ity",ity
+ if (atom.eq.'CA' .or. atom.eq.'CH3' .or.
+ & res.eq.'NHE'.and.atom(:2).eq.'HN') then
read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
- if(me.eq.king.or..not.out1file)
- & write (iout,'(2i3,2x,a,3f8.3)')
- & ires,itype(ires),res,(c(j,ires),j=1,3)
- iii=1
+c write (iout,*) "backbone ",atom
+#ifdef DEBUG
+ write (iout,'(2i3,2x,a,3f8.3)')
+ & ires,itype(ires),res,(c(j,ires),j=1,3)
+#endif
+ iii=iii+1
do j=1,3
sccor(j,iii)=c(j,ires)
enddo
- else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and.
- & atom.ne.'N ' .and. atom.ne.'C ') then
+c write (*,*) card(23:27),ires,itype(ires)
+ else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and.
+ & atom.ne.'N' .and. atom.ne.'C' .and.
+ & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and.
+ & atom.ne.'OXT' .and. atom(:2).ne.'3H') then
+c write (iout,*) "sidechain ",atom
iii=iii+1
read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
endif
endif
enddo
- 10 if(me.eq.king.or..not.out1file)
- & write (iout,'(a,i5)') ' Nres: ',ires
+ 10 write (iout,'(a,i5)') ' Number of residues found: ',ires
+ if (ires.eq.0) return
C Calculate dummy residue coordinates inside the "chain" of a multichain
C system
nres=ires
do i=2,nres-1
c write (iout,*) i,itype(i)
- if (itype(i).eq.21) then
+ if (itype(i).eq.ntyp1) then
c write (iout,*) "dummy",i,itype(i)
do j=1,3
c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2
endif
enddo
C Calculate the CM of the last side chain.
+ if (iii.gt.0) then
if (unres_pdb) then
do j=1,3
dc(j,ires)=sccor(j,iii)
enddo
- else
+ else
call sccenter(ires,iii,sccor)
endif
+ endif
+c nres=ires
nsup=nres
nstart_sup=1
if (itype(nres).ne.10) then
nres=nres+1
- itype(nres)=21
+ itype(nres)=ntyp1
if (unres_pdb) then
C 2/15/2013 by Adam: corrected insertion of the last dummy residue
call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail)
c(j,nres+1)=c(j,1)
c(j,2*nres)=c(j,nres)
enddo
- if (itype(1).eq.21) then
+ if (itype(1).eq.ntyp1) then
nsup=nsup-1
nstart_sup=2
if (unres_pdb) then
enddo
endif
endif
+C Copy the coordinates to reference coordinates
+c do i=1,2*nres
+c do j=1,3
+c cref(j,i)=c(j,i)
+c enddo
+c enddo
+C Calculate internal coordinates.
+ if (lprn) then
+ write (iout,'(/a)')
+ & "Cartesian coordinates of the reference structure"
+ write (iout,'(a,3(3x,a5),5x,3(3x,a5))')
+ & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)"
+ do ires=1,nres
+ write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)')
+ & restyp(itype(ires)),ires,(c(j,ires),j=1,3),
+ & (c(j,ires+nres),j=1,3)
+ enddo
+ endif
C Calculate internal coordinates.
if(me.eq.king.or..not.out1file)then
+ write (iout,'(a)')
+ & "Backbone and SC coordinates as read from the PDB"
do ires=1,nres
write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)')
& ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3),
endif
call int_from_cart(.true.,.false.)
call sc_loc_geom(.true.)
+c wczesbiej bylo false
do i=1,nres
thetaref(i)=theta(i)
phiref(i)=phi(i)
c call chainbuild
C Copy the coordinates to reference coordinates
C Splits to single chain if occurs
+
+c do i=1,2*nres
+c do j=1,3
+c cref(j,i,cou)=c(j,i)
+c enddo
+c enddo
+c
kkk=1
lll=0
cou=1
lll=lll+1
cc write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
if (i.gt.1) then
- if ((itype(i-1).eq.21)) then
+ if ((itype(i-1).eq.ntyp1).and.(i.gt.2)) then
chain_length=lll-1
kkk=kkk+1
c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3)
endif
enddo
enddo
+ write (iout,*) chain_length
+ if (chain_length.eq.0) chain_length=nres
do j=1,3
chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1)
chain_rep(j,chain_length+nres,symetr)
c write (iout,*) itype(kkk),(chain_rep(j,kkk,i), j=1,3)
c enddo
c enddo
-c enddiagnostic
+c enddiagnostic
C makes copy of chains
write (iout,*) "symetr", symetr
-
+
if (symetr.gt.1) then
call permut(symetr)
nperm=1
1 ' ', 6X,'X',11X,'Y',11X,'Z',
& 10X,'X',11X,'Y',11X,'Z')
110 format (a,'(',i3,')',6f12.5)
-
+
enddo
cc enddiag
do j=1,nbfrag
hfrag(i,j)=hfrag(i,j)-ishift
enddo
enddo
-
+ ishift_pdb=ishift
return
end
c---------------------------------------------------------------------------
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
-#endif
+#endif
include 'COMMON.LOCAL'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
include 'COMMON.NAMES'
include 'COMMON.CONTROL'
include 'COMMON.SETUP'
- character*3 seq,atom,res
+ character*3 seq,res
+c character*5 atom
character*80 card
dimension sccor(3,20)
integer rescode
logical lside,lprn
-#ifdef MPI
if(me.eq.king.or..not.out1file)then
-#endif
if (lprn) then
write (iout,'(/a)')
& 'Internal coordinates calculated from crystal structure.'
if (lside) then
write (iout,'(8a)') ' Res ',' dvb',' Theta',
- & ' Phi',' Dsc_id',' Dsc',' Alpha',
- & ' Omega'
+ & ' Gamma',' Dsc_id',' Dsc',' Alpha',
+ & ' Beta '
else
write (iout,'(4a)') ' Res ',' dvb',' Theta',
- & ' Phi'
+ & ' Gamma'
endif
endif
-#ifdef MPI
endif
-#endif
do i=1,nres-1
iti=itype(i)
- if (iti.ne.21 .and. itype(i+1).ne.21 .and.
- & (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0)) then
+ if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then
write (iout,'(a,i4)') 'Bad Cartesians for residue',i
ctest stop
endif
enddo
iti=itype(i)
di=dist(i,nres+i)
+C 10/03/12 Adam: Correction for zero SC-SC bond length
+ if (itype(i).ne.10 .and. itype(i).ne.ntyp1. and. di.eq.0.0d0)
+ & di=dsc(itype(i))
vbld(i+nres)=di
if (itype(i).ne.10) then
vbld_inv(i+nres)=1.0d0/di
include 'DIMENSIONS'
#ifdef MPI
include "mpif.h"
-#endif
+#endif
include 'COMMON.LOCAL'
include 'COMMON.VAR'
include 'COMMON.CHAIN'
enddo
enddo
do i=2,nres-1
- if (itype(i).ne.10 .and. itype(i).ne.21) then
+ if (itype(i).ne.10) then
do j=1,3
dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i))
enddo
sinfac2=0.5d0/(1.0d0-costtab(i+1))
sinfac=dsqrt(sinfac2)
it=itype(i)
- if (it.ne.10 .and. itype(i).ne.21) then
+ if (it.ne.10) then
c
C Compute the axes of tghe local cartesian coordinates system; store in
c x_prime, y_prime and z_prime
if (lprn) then
do i=2,nres
iti=itype(i)
-#ifdef MPI
if(me.eq.king.or..not.out1file)
& write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),
& yyref(i),zzref(i)
-#else
- write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),yyref(i),
- & zzref(i)
-#endif
enddo
endif
return
enddo
return
end
-
integer*2 i_index
& (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
common /przechowalnia/ d_restart1
+ integer i2set_(0:maxprocs)
write (*,*) "Processor",me," called read1restart"
if(me.eq.king)then
enddo
endif
#endif
- call mpi_scatter(i2set,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
-
+c Corrected AL 8/19/2014: each processor needs whole iset array not only its
+c own element
+c call mpi_scatter(i2set,1,mpi_integer,
+c & iset,1,mpi_integer,king,
+c & CG_COMM,ierr)
+ call mpi_bcast(i2set(0),nodes,mpi_integer,king,
+ & CG_COMM,ierr)
+ iset=i2set(me)
endif
-
if(me.eq.king) close(irest2)
return
end
integer*2 i_index
& (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
common /przechowalnia/ d_restart1
+ integer i2set_(0:maxprocs)
write (*,*) "Processor",me," called read1restart"
if(me.eq.king)then
enddo
endif
#endif
- call mpi_scatter(i2set,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
-
+c Corrected AL 8/19/2014: each processor needs whole iset array not only its
+c own element
+c call mpi_scatter(i2set,1,mpi_integer,
+c & iset,1,mpi_integer,king,
+c & CG_COMM,ierr)
+ call mpi_bcast(i2set(0),nodes,mpi_integer,king,
+ & CG_COMM,ierr)
+ iset=i2set(me)
endif
-
if(me.eq.king) close(irest2)
return
end
+++ /dev/null
-#
-# CMake project file for UNRES with MD for single chains
-#
-
-enable_language (Fortran)
-
-
-#================================
-# Set source file lists
-#================================
-set(UNRES_MD_SRC0
- add.f
- arcos.f
- banach.f
- blas.f
- bond_move.f
- cartder.F
- cartprint.f
- check_sc_distr.f
- check_bond.f
- chainbuild.F
- checkder_p.F
- compare_s1.F
- contact.f
- convert.f
- cored.f
- dihed_cons.F
- djacob.f
- econstr_local.F
- eigen.f
- elecont.f
- energy_split-sep.F
- entmcm.F
- fitsq.f
- gauss.f
- gen_rand_conf.F
- geomout.F
- gnmr1.f
- intcartderiv.F
- initialize_p.F
- int_to_cart.f
- intcor.f
- intlocal.f
- kinetic_lesyng.f
- lagrangian_lesyng.F
- local_move.f
- map.f
- matmult.f
- mc.F
- mcm.F
- MD_A-MTS.F
- minimize_p.F
- minim_mcmf.F
- misc.f
- moments.f
- MP.F
- MREMD.F
- muca_md.f
- parmread.F
- pinorm.f
- printmat.f
- q_measure.F
- randgens.f
- rattle.F
- readpdb.F
- readrtns.F
- refsys.f
- regularize.F
- rescode.f
- rmdd.f
- rmsd.F
- sc_move.F
- sort.f
- stochfric.F
- sumsld.f
- surfatom.f
- test.F
- timing.F
- thread.F
- unres.F
- ssMD.F
-)
-
-if(Fortran_COMPILER_NAME STREQUAL "ifort")
- set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f )
-elseif(Fortran_COMPILER_NAME STREQUAL "mpif90")
- set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f )
-elseif(Fortran_COMPILER_NAME STREQUAL "f95")
- set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f )
-elseif(Fortran_COMPILER_NAME STREQUAL "gfortran")
- set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f )
-else()
- set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng_32.F )
-endif (Fortran_COMPILER_NAME STREQUAL "ifort")
-
-
-set(UNRES_MD_SRC3
- energy_p_new_barrier.F
- energy_p_new-sep_barrier.F
- gradient_p.F )
-
-set(UNRES_MD_PP_SRC
- cartder.F
- chainbuild.F
- checkder_p.F
- compare_s1.F
- dihed_cons.F
- econstr_local.F
- energy_p_new_barrier.F
- energy_p_new-sep_barrier.F
- energy_split-sep.F
- entmcm.F
- gen_rand_conf.F
- geomout.F
- gradient_p.F
- initialize_p.F
- intcartderiv.F
- lagrangian_lesyng.F
- mc.F
- mcm.F
- MD_A-MTS.F
- minimize_p.F
- minim_mcmf.F
- MP.F
- MREMD.F
- parmread.F
- q_measure1.F
- q_measure3.F
- q_measure.F
- rattle.F
- readpdb.F
- readrtns.F
- regularize.F
- rmsd.F
- sc_move.F
- stochfric.F
- test.F
- thread.F
- timing.F
- unres.F
- proc_proc.c
-)
-
-
-if(NOT Fortran_COMPILER_NAME STREQUAL "ifort")
- set(UNRES_MD_PP_SRC ${UNRES_MD_PP_SRC} prng_32.F)
-endif(NOT Fortran_COMPILER_NAME STREQUAL "ifort")
-
-#================================================
-# Set comipiler flags for different sourcefiles
-#================================================
-if (Fortran_COMPILER_NAME STREQUAL "ifort")
- set(FFLAGS0 "-ip -w" )
- set(FFLAGS1 "-w -g -d2 -CA -CB" )
- set(FFLAGS2 "-w -g -00 ")
- #set(FFLAGS3 "-c -w -O3 -ipo -ipo_obj -opt_report" )
- set(FFLAGS3 "-w -ipo " )
-elseif (Fortran_COMPILER_NAME STREQUAL "gfortran")
- set(FFLAGS0 "-std=legacy -I. " )
- set(FFLAGS1 "-std=legacy -g -I. " )
- set(FFLAGS2 "-std=legacy -I. ")
- #set(FFLAGS3 "-c -w -O3 -ipo -ipo_obj -opt_report" )
- set(FFLAGS3 "-std=legacy -I. " )
-endif (Fortran_COMPILER_NAME STREQUAL "ifort")
-
-
-# Add MPI compiler flags
-if(UNRES_WITH_MPI)
- set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}")
- set(FFLAGS1 "${FFLAGS1} -I${MPIF_INCLUDE_DIRECTORIES}")
- set(FFLAGS2 "${FFLAGS2} -I${MPIF_INCLUDE_DIRECTORIES}")
- set(FFLAGS3 "${FFLAGS3} -I${MPIF_INCLUDE_DIRECTORIES}")
-endif(UNRES_WITH_MPI)
-
-set_property(SOURCE ${UNRES_MD_SRC0} APPEND PROPERTY COMPILE_FLAGS ${FFLAGS0} )
-#set_property(SOURCE ${UNRES_MD_SRC1} PROPERTY COMPILE_FLAGS ${FFLAGS1} )
-#set_property(SOURCE ${UNRES_MD_SRC2} PROPERTY COMPILE_FLAGS ${FFLAGS2} )
-set_property(SOURCE ${UNRES_MD_SRC3} PROPERTY COMPILE_FLAGS ${FFLAGS3} )
-
-#=========================================
-# Settings for GAB force field
-#=========================================
-if(UNRES_MD_FF STREQUAL "GAB" )
- # set preprocesor flags
- set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" )
-
-#=========================================
-# Settings for E0LL2Y force field
-#=========================================
-elseif(UNRES_MD_FF STREQUAL "E0LL2Y")
- # set preprocesor flags
- set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0" )
-endif(UNRES_MD_FF STREQUAL "GAB")
-
-#=========================================
-# System specific flags
-#=========================================
-if(${CMAKE_SYSTEM_NAME} MATCHES "Linux")
- set(CPPFLAGS "${CPPFLAGS} -DLINUX")
-endif(${CMAKE_SYSTEM_NAME} MATCHES "Linux")
-
-#=========================================
-# Compiler specific flags
-#=========================================
-
-if (Fortran_COMPILER_NAME STREQUAL "ifort")
- # Add ifort preprocessor flags
- set(CPPFLAGS "${CPPFLAGS} -DPGI")
-elseif (Fortran_COMPILER_NAME STREQUAL "f95")
- # Add new gfortran flags
- set(CPPFLAGS "${CPPFLAGS} -DG77")
-elseif (Fortran_COMPILER_NAME STREQUAL "gfortran")
- # Add old gfortran flags
- set(CPPFLAGS "${CPPFLAGS} -DG77")
-endif (Fortran_COMPILER_NAME STREQUAL "ifort")
-
-#=========================================
-# Add MPI preprocessor flags
-#=========================================
-if (UNRES_WITH_MPI)
- set(CPPFLAGS "${CPPFLAGS} -DMP -DMPI")
-endif(UNRES_WITH_MPI)
-
-#=========================================
-# Apply preprocesor flags to *.F files
-#=========================================
-set_property(SOURCE ${UNRES_MD_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS} )
-
-
-#========================================
-# Setting binary name
-#========================================
-if(UNRES_WITH_MPI)
- # binary with mpi
- set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_MPICH_${UNRES_MD_FF}.exe")
-else(UNRES_WITH_MPI)
- # binary without mpi
- set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_single_${UNRES_MD_FF}.exe")
-endif(UNRES_WITH_MPI)
-
-#=========================================
-# cinfo.f workaround for cmake
-#=========================================
-# get the current date
-TODAY(DATE)
-# generate cinfo.f
-
-set(CINFO "${CMAKE_CURRENT_BINARY_DIR}/cinfo.f")
-FILE(WRITE ${CINFO}
-"C CMake generated file
- subroutine cinfo
- include 'COMMON.IOUNITS'
- write(iout,*)'++++ Compile info ++++'
- write(iout,*)'Version ${UNRES_MAJOR}.${UNRES_MINOR} build ${UNRES_PATCH}'
-")
-
-CINFO_FORMAT(${CINFO} "Compiled" "${DATE}" )
-CINFO_FORMAT(${CINFO} "Compiled by" "$ENV{USER}@$ENV{HOST}" )
-CINFO_FORMAT(${CINFO} "OS name:" "${CMAKE_SYSTEM_NAME}" )
-CINFO_FORMAT(${CINFO} "OS release:" "${CMAKE_SYSTEM}" )
-CINFO_FORMAT(${CINFO} "Fortran Compiler:" "${CMAKE_Fortran_COMPILER}" )
-CINFO_FORMAT(${CINFO} "MD Force field:" "${UNRES_MD_FF}" )
-CINFO_FORMAT(${CINFO} "CPPFLAGS =" "${CPPFLAGS}")
-
-FILE(APPEND ${CINFO}
-" write(iout,*)'++++ End of compile info ++++'
- return
- end ")
-
-# add include path
-set_property(SOURCE ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f PROPERTY COMPILE_FLAGS "${FFLAGS0} -I${CMAKE_CURRENT_SOURCE_DIR}")
-
-#=========================================
-# Set full unres MD sources
-#=========================================
-set(UNRES_MD_SRCS ${UNRES_MD_SRC0} ${UNRES_MD_SRC3} ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f )
-
-
-#=========================================
-# Build the binary
-#=========================================
-add_executable(UNRES_BIN-MD ${UNRES_MD_SRCS} )
-set_target_properties(UNRES_BIN-MD PROPERTIES OUTPUT_NAME ${UNRES_BIN})
-#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD )
-#add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB})
-
-
-#=========================================
-# Link libraries
-#=========================================
-# link MPI library (libmpich.a)
-if(UNRES_WITH_MPI)
- target_link_libraries( UNRES_BIN-MD ${MPIF_LIBRARIES} )
-endif(UNRES_WITH_MPI)
-# link libxdrf.a
-#message("UNRES_XDRFLIB=${UNRES_XDRFLIB}")
-target_link_libraries( UNRES_BIN-MD xdrf )
-
-#=========================================
-# TESTS
-#=========================================
-
-#-- Copy all the data files from the test directory into the source directory
-#SET(UNRES_TEST_FILES
-# ala10.inp
-# )
-
-#FOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES})
-# SET (unres_test_dest "${CMAKE_CURRENT_BINARY_DIR}/${UNRES_TEST_FILE}")
-# MESSAGE (STATUS " Copying ${UNRES_TEST_FILE} from ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} to ${unres_test_dest}")
-# ADD_CUSTOM_COMMAND (
-# TARGET ${UNRES_BIN}
-# POST_BUILD
-# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} ${unres_test_dest}
-# )
-#ENDFOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES})
-
-#=========================================
-# Generate data test files
-#=========================================
-# test_single_ala.sh
-#=========================================
-
-FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_single_ala.sh
-"#!/bin/sh
-export POT=GB
-export PREFIX=ala10
-#-----------------------------------------------------------------------------
-UNRES_BIN=./${UNRES_BIN}
-#-----------------------------------------------------------------------------
-DD=${CMAKE_SOURCE_DIR}/PARAM
-export BONDPAR=$DD/bond.parm
-export THETPAR=$DD/thetaml.5parm
-export ROTPAR=$DD/scgauss.parm
-export TORPAR=$DD/torsion_631Gdp.parm
-export TORDPAR=$DD/torsion_double_631Gdp.parm
-export ELEPAR=$DD/electr_631Gdp.parm
-export SIDEPAR=$DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k
-export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3
-export SCPPAR=$DD/scp.parm
-export SCCORPAR=$DD/sccor_pdb_shelly.dat
-export PATTERN=$DD/patterns.cart
-#-----------------------------------------------------------------------------
-$UNRES_BIN
-")
-
-#
-# File permissions workaround
-#
-FILE( COPY ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_single_ala.sh
- DESTINATION ${CMAKE_CURRENT_BINARY_DIR}
- FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE
-)
-
-
-
-#=========================================
-# ala10.inp
-#=========================================
-
-file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/ala10.inp
-"ala10 unblocked
-SEED=-1111333 MD ONE_LETTER rescale_mode=2
-nstep=15000 ntwe=100 ntwx=1000 dt=0.1 lang=0 tbf t_bath=300 damax=1.0 &
-reset_moment=1000 reset_vel=1000
-WLONG=1.35279 WSCP=1.59304 WELEC=0.71534 WBOND=1.00000 WANG=1.13873 &
-WSCLOC=0.16258 WTOR=1.98599 WTORD=1.57069 WCORRH=0.42887 WCORR5=0.00000 &
-WCORR6=0.00000 WEL_LOC=0.16036 WTURN3=1.68722 WTURN4=0.66230 WTURN6=0.00000 &
-WVDWPP=0.11371 WHPB=1.00000 &
-CUTOFF=7.00000 WCORR4=0.00000
-12
-XAAAAAAAAAAX
- 0
- 0
- 90.0000 90.0000 90.0000 90.000 90.000 90.000 90.000 90.000
- 90.0000 90.0000
- 180.0000 180.0000 180.0000 180.000 180.000 180.000 180.000 180.000
- 180.0000
- 110.0000 110.0000 110.0000 100.000 110.000 100.000 110.000 110.000
- 110.0000 110.0000
- -120.0000 -120.0000 -120.000 -120.000 -120.000 -120.000 -120.000 -120.000
- -120.0000 -120.0000
-")
-
-
-# Add tests
-
-if(NOT UNRES_WITH_MPI)
-
- add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh )
-
-else(NOT UNRES_WITH_MPI)
-
-
- add_test(NAME UNRES_MD_MPI_Ala10 COMMAND mpiexec -boot ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh )
-
-endif(NOT UNRES_WITH_MPI)
-
+++ /dev/null
- double precision phibound(2,maxres)
- common /bounds/ phibound
+++ /dev/null
- integer ncache,CachSrc(max_cache),isent(max_cache),
- & iused(max_cache)
- logical cache_update
- double precision ecache(max_cache),xcache(maxvar,max_cache)
- common /cache/ ecache,xcache,ncache,CachSrc,isent,iused,
- & cache_update
+++ /dev/null
- integer i,j,k,l
- double precision erij,rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj,
- & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12,
- & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1,
- & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2,
- & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2,
- & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder,
- & dsci_inv,dscj_inv,gg
- common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj,
- & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12,
- & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1,
- & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2,
- & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2,
- & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder,
- & dsci_inv,dscj_inv,gg(3),i,j
+++ /dev/null
- integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc,
- & nres0,nstart_seq
- double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r,
- & prod,rt,dc_work,cref,crefjlee,dc_norm2
- common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2),
- & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2),
- & dc_norm2(3,0:maxres2),
- & dc_work(MAXRES6),nres,nres0
- common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres),
- & rt(3,3,maxres)
- common /refstruct/ cref(3,maxres2+2),crefjlee(3,maxres2+2),
- & nsup,nstart_sup,nstart_seq
- common /from_zscore/ nz_start,nz_end,iz_sc
+++ /dev/null
-C Change 12/1/95 - common block CONTACTS1 included.
- integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont
- double precision facont,gacont
- common /contacts/ ncont,ncont_ref,icont(2,maxcont),
- & icont_ref(2,maxcont)
- common /contacts1/ facont(maxconts,maxres),
- & gacont(3,maxconts,maxres),
- & num_cont(maxres),jcont(maxconts,maxres)
-C 12/26/95 - H-bonding contacts
- common /contacts_hb/
- & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres),
- & gacontp_hb3(3,maxconts,maxres),
- & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres),
- & gacontm_hb3(3,maxconts,maxres),
- & gacont_hbr(3,maxconts,maxres),
- & grij_hb_cont(3,maxconts,maxres),
- & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
- & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
- & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
-C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
-C interactions
-c 7/25/08 Commented out; not needed when cumulants used
-C Interactions of pseudo-dipoles generated by loc-el interactions.
-c double precision dip,dipderg,dipderx
-c common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres),
-c & dipderx(3,5,4,maxconts,maxres)
-C 10/30/99 Added other pre-computed vectors and matrices needed
-C to calculate three - six-order el-loc correlation terms
- double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der,
- & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder,
- & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der
- common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres),
- & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres),
- & obrot_der(2,maxres),obrot2_der(2,maxres)
-C This common block contains vectors and matrices dependent on a single
-C amino-acid residue.
- common /precomp1/ mu(2,maxres),muder(2,maxres),Ub2(2,maxres),
- & Ub2der(2,maxres),Ctobr(2,maxres),Ctobrder(2,maxres),
- & Dtobr2(2,maxres),Dtobr2der(2,maxres),
- & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres),
- & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres),
- & DtUg2(2,2,maxres),DtUg2der(2,2,maxres)
-C This common block contains vectors and matrices dependent on two
-C consecutive amino-acid residues.
- double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC,
- & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder
- common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres),
- & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres),
- & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres),
- & DtUg2EUg(2,2,maxres),Ug2DtEUg(2,2,maxres),
- & Ug2DtEUgder(2,2,2,maxres),DtUg2EUgder(2,2,2,maxres)
- double precision costab,sintab,costab2,sintab2
- common /rotat_old/ costab(maxres),sintab(maxres),
- & costab2(maxres),sintab2(maxres)
-C This common block contains dipole-interaction matrices and their
-C Cartesian derivatives.
- double precision a_chuj,a_chuj_der
- common /dipmat/ a_chuj(2,2,maxconts,maxres),
- & a_chuj_der(2,2,3,5,maxconts,maxres)
- double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx,
- & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx,
- & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont
- common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2),
- & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2),
- & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2),
- & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2),
- & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2),
- & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2),
- & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2),
- & g_contij(3,2),ekont
-C 12/13/2008 (again Poland-Jaruzel war anniversary)
-C RE: Parallelization of 4th and higher order loc-el correlations
- integer ncont_sent,ncont_recv,iint_sent,iisent_local,
- & itask_cont_from,itask_cont_to,ntask_cont_from,ntask_cont_to,
- & nat_sent,iat_sent,iturn3_sent,iturn4_sent,iturn3_sent_local,
- & iturn4_sent_local
- common /contdistrib/ ncont_sent(maxres),ncont_recv(maxres),
- & iint_sent(4,maxres,maxres),iint_sent_local(4,maxres,maxres),
- & iturn3_sent(4,maxres),iturn4_sent(4,maxres),
- & iturn3_sent_local(4,maxres),iturn4_sent_local(4,maxres),
- & nat_sent,iat_sent(maxres),itask_cont_from(0:max_fg_procs-1),
- & itask_cont_to(0:max_fg_procs-1),ntask_cont_from,ntask_cont_to
+++ /dev/null
-C Change 12/1/95 - common block CONTACTS1 included.
- integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont
- double precision facont,gacont
- common /contacts/ ncont,ncont_ref,icont(2,maxcont),
- & icont_ref(2,maxcont)
- common /contacts1/ facont(maxconts,maxres),
- & gacont(3,maxconts,maxres),
- & num_cont(maxres),jcont(maxconts,maxres)
-C 12/26/95 - H-bonding contacts
- common /contacts_hb/
- & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres),
- & gacontp_hb3(3,maxconts,maxres),
- & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres),
- & gacontm_hb3(3,maxconts,maxres),
- & gacont_hbr(3,maxconts,maxres),
- & grij_hb_cont(3,maxconts,maxres),
- & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
- & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
- & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
-C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
-C interactions
-C Interactions of pseudo-dipoles generated by loc-el interactions.
- double precision dip,dipderg,dipderx
- common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres),
- & dipderx(3,5,4,maxconts,maxres)
-C 10/30/99 Added other pre-computed vectors and matrices needed
-C to calculate three - six-order el-loc correlation terms
- double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der,
- & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder,
- & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der
- common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres),
- & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres),
- & obrot_der(2,maxres),obrot2_der(2,maxres)
-C This common block contains vectors and matrices dependent on a single
-C amino-acid residue.
- common /precomp1/ Ub2(2,maxres),Ub2der(2,maxres),mu(2,maxres),
- & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres),
- & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres),
- & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),Ctobr(2,maxres),
- & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres)
-C This common block contains vectors and matrices dependent on two
-C consecutive amino-acid residues.
- double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC,
- & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder
- common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres),
- & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres),
- & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres),
- & DtUg2EUg(2,2,maxres),DtUg2EUgder(2,2,2,maxres),
- & Ug2DtEUg(2,2,maxres),Ug2DtEUgder(2,2,2,maxres)
- double precision costab,sintab,costab2,sintab2
- common /rotat_old/ costab(maxres),sintab(maxres),
- & costab2(maxres),sintab2(maxres),muder(2,maxres)
-C This common block contains dipole-interaction matrices and their
-C Cartesian derivatives.
- double precision a_chuj,a_chuj_der
- common /dipmat/ a_chuj(2,2,maxconts,maxres),
- & a_chuj_der(2,2,3,5,maxconts,maxres)
- double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx,
- & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx,
- & AEAb2,AEAb2derg,AEAb2derx
- common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2),
- & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2),
- & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2),
- & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2),
- & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2),
- & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2),
- & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2),
- & g_contij(3,2),ekont
+++ /dev/null
- integer modecalc,iscode,indpdb,indback,indphi,iranconf,icheckgrad,
- & inprint,i2ndstr,mucadyn,constr_dist,constr_homology
- real*8 waga_dist, waga_angle
- logical minim,refstr,pdbref,outpdb,outmol2,overlapsc,energy_dec,
- & sideadd,lsecondary,read_cart,unres_pdb,
- & vdisulf,searchsc,lmuca,dccart,extconf,out1file,
- & gnorm_check,gradout,split_ene
- common /cntrl/ modecalc,iscode,indpdb,indback,indphi,iranconf,
- & icheckgrad,minim,i2ndstr,refstr,pdbref,outpdb,outmol2,iprint,
- & overlapsc,energy_dec,sideadd,lsecondary,read_cart,unres_pdb
- & ,vdisulf,searchsc,lmuca,dccart,mucadyn,extconf,out1file,
- & constr_dist,gnorm_check,gradout,split_ene,constr_homology,
- & waga_dist, waga_angle
-C... minim = .true. means DO minimization.
-C... energy_dec = .true. means print energy decomposition matrix
+++ /dev/null
- common /struct/ cart_base(3,maxres_base,maxseq),str_nam(maxseq),
- & nres_base(3,maxseq),nseq
- character*8 str_nam
+++ /dev/null
- double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long,
- & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp,
- & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha,
- & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long,
- & gradcorr6_long,gcorr6_turn_long,gvdwcT,gvdwxT,gvdwx
- integer nfl,icg
- common /derivatT/ gvdwcT(3,maxres),gvdwxT(3,maxres)
- common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres),
- & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres),
- & gvdwc(3,maxres),gelc(3,maxres),gelc_long(3,maxres),
- & gvdwpp(3,maxres),gvdwc_scpp(3,maxres),
- & gradx_scp(3,maxres),gvdwc_scp(3,maxres),ghpbx(3,maxres),
- & ghpbc(3,maxres),gloc(maxvar,2),gradcorr(3,maxres),
- & gradcorr_long(3,maxres),gradcorr5_long(3,maxres),
- & gradcorr6_long(3,maxres),gcorr6_turn_long(3,maxres),
- & gradxorr(3,maxres),gradcorr5(3,maxres),gradcorr6(3,maxres),
- & gloc_x(maxvar,2),gel_loc(3,maxres),gel_loc_long(3,maxres),
- & gcorr3_turn(3,maxres),
- & gcorr4_turn(3,maxres),gcorr6_turn(3,maxres),gradb(3,maxres),
- & gradbx(3,maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar),
- & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar),gcorr_loc(maxvar),
- & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres),
- & gsccorx(3,maxres),gsccor_loc(maxres),dtheta(3,2,maxres),
- & gscloc(3,maxres),gsclocx(3,maxres),
- & dphi(3,3,maxres),dalpha(3,3,maxres),domega(3,3,maxres),nfl,icg
- double precision derx,derx_turn
- common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2)
- double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres),
- & dZZ_C1tab(3,maxres),dXX_Ctab(3,maxres),dYY_Ctab(3,maxres),
- & dZZ_Ctab(3,maxres),dXX_XYZtab(3,maxres),dYY_XYZtab(3,maxres),
- & dZZ_XYZtab(3,maxres)
- common /deriv_scloc/ dXX_C1tab,dYY_C1tab,dZZ_C1tab,dXX_Ctab,
- & dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,dZZ_XYZtab
- integer igrad_start,igrad_end,jgrad_start(maxres),
- & jgrad_end(maxres)
- common /mpgrad/ igrad_start,igrad_end,jgrad_start,jgrad_end
+++ /dev/null
-c parameter (maxres22=maxres*(maxres+1)/2)
- parameter (maxres22=1)
- double precision w,d0,DRDG,DD,H,XX
- integer nbfrag,bfrag,nhfrag,hfrag,bvar_frag,hvar_frag,nhpb0,
- 1 lvar_frag,svar_frag,avar_frag
- COMMON /c_frag/ nbfrag,bfrag(4,maxres/3),nhfrag,hfrag(2,maxres/3)
-csa COMMON /frag/ bvar_frag(mxio,6),hvar_frag(mxio,3),
-csa 1 lvar_frag(mxio,3),svar_frag(mxio,3),
-csa 2 avar_frag(mxio,5)
- COMMON /WAGI/ w(MAXRES22),d0(MAXRES22)
- COMMON /POCHODNE/ NX,NY,DRDG(MAXRES22,MAXRES),DD(MAXRES22),
- 1 H(MAXRES,MAXRES),XX(MAXRES)
- COMMON /frozen/ mask(maxres)
- COMMON /store0/ nhpb0
+++ /dev/null
-C-----------------------------------------------------------------------
-C The following COMMON block selects the type of the force field used in
-C calculations and defines weights of various energy terms.
-C 12/1/95 wcorr added
-C-----------------------------------------------------------------------
- integer n_ene_comp,rescale_mode
- common /ffield/ wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,wang,
- & wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,
- & wturn6,wvdwpp,wsct,weights(n_ene),temp0,
- & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp,
- & rescale_mode
- common /potentials/ potname(5)
- character*3 potname
-C-----------------------------------------------------------------------
-C wlong,welec,wtor,wang,wscloc are the weight of the energy terms
-C corresponding to side-chain, electrostatic, torsional, valence-angle,
-C and local side-chain terms.
-C
-C IPOT determines which SC...SC interaction potential will be used:
-C 1 - LJ: 2n-n Lennard-Jones
-C 2 - LJK: 2n-n Kihara type (shifted Lennard-Jones)
-C 3 - BP; Berne-Pechukas (angular dependence)
-C 4 - GB; Gay-Berne (angular dependence)
-C 5 - GBV; Gay-Berne-Vorobjev; angularly-dependent Kihara potential
-C------------------------------------------------------------------------
+++ /dev/null
- double precision pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin
- common /geo/ pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin
+++ /dev/null
- integer nharp_seed(max_seed),nharp_tot,
- & iharp_seed(4,maxres/3,max_seed),iharp_use(0:4,maxres/3,max_seed),
- & nharp_use(max_seed)
- common /spinka/ nharp_seed,nharp_tot,iharp_seed,iharp_use,
- & nharp_use
+++ /dev/null
- character*80 titel
- common /header/ titel
+++ /dev/null
-c NPROCS - total number of processors;
-c MyID - processor's ID;
-c MasterID - master processor's ID.
- integer MyId,AllGrp,DontCare,MasterId,WhatsUp,ifinish
- logical koniec
- integer tag,status(MPI_STATUS_SIZE)
- common /info/ myid,masterid,allgrp,dontcare,
- & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1)
-c... 5/12/96 - added variables for collective communication
-c FGPROCS - Number of fine-grain processors per coarse-grain task;
-c NCTASKS - Number of coarse-grain tasks;
-c MYGROUP - label of the processor's FG group id;
-c BOSSID - ID of group's master;
-c FGLIST - list of group's FG processors.
-c MSGLEN_VAR - length of the vector of variables passed to the fine-grain
-c slave processors
- integer fgprocs,nctasks,mygroup,bossid,cglabel,
- & cglist(max_cg_procs),cgGroupID,fglist(max_fg_procs),
- & fgGroupID,MyRank
- common /info1/ fgprocs,nctasks,mygroup,bossid,cglabel,cglist,
- & cgGroupID,fglist,fgGroupID,MyRank,msglen_var
+++ /dev/null
- double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6
- integer expon,expon2
- integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro,
- & ielstart,ielend,ielstart_vdw,ielend_vdw,nscp_gr,iscpstart,
- & iscpend,iatsc_s,iatsc_e,
- & iatel_s,iatel_e,iatscp_s,iatscp_e,iatel_s_vdw,iatel_e_vdw,
- & ispp,iscp
- common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp),
- & aad(ntyp,2),bad(ntyp,2),app(2,2),bpp(2,2),ael6(2,2),ael3(2,2),
- & expon,expon2,nnt,nct,nint_gr(maxres),istart(maxres,maxint_gr),
- & iend(maxres,maxint_gr),itype(maxres),itel(maxres),itypro,
- & ielstart(maxres),ielend(maxres),ielstart_vdw(maxres),
- & ielend_vdw(maxres),nscp_gr(maxres),
- & iscpstart(maxres,maxint_gr),iscpend(maxres,maxint_gr),
- & iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,iatel_e_vdw,
- & iatscp_s,iatscp_e,ispp,iscp
-C 12/1/95 Array EPS included in the COMMON block.
- double precision eps,sigma,sigmaii,rs0,chi,chip,alp,sigma0,sigii,
- & rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp
- common /body/eps(ntyp,ntyp),sigma(0:ntyp1,0:ntyp1),
- & sigmaii(ntyp,ntyp),
- & rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),alp(ntyp),sigma0(ntyp),
- & sigii(ntyp),rr0(ntyp),r0(ntyp,ntyp),r0e(ntyp,ntyp),r0d(ntyp,2),
- & rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2),eps_scp(20,2),rscp(20,2)
-c 12/5/03 modified 09/18/03 Bond stretching parameters.
- double precision vbldp0,vbldsc0,akp,aksc,abond0
- integer nbondterm
- common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp,
- & aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp),nbondterm(ntyp)
- double precision wdti,wdti2,wdti4,wdti8,
- & wdtii,wdtii2,wdtii4,wdtii8
- common /nosehoover_dt/
- & wdti(maxyosh),wdti2(maxyosh),wdti4(maxyosh),wdti8(maxyosh),
- & wdtii(maxyosh),wdtii2(maxyosh),wdtii4(maxyosh),wdtii8(maxyosh)
+++ /dev/null
-C-----------------------------------------------------------------------
-C I/O units used by the program
-C-----------------------------------------------------------------------
-C 9/18/99 - unit ifourier and filename fouriername included to identify
-C the file from which the coefficients of second-order Fourier expansion
-C of the local-interaction energy are read.
-C 8/9/01 - file for SCP interaction constants named scpname (unit iscpp)
-C included.
-C-----------------------------------------------------------------------
-C General I/O units & files
- integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam,
- & itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,istat,
- & ientin,ientout,izs1,isecpred,ibond,irest2,iifrag,icart,
- & irest1,isccor,ithep_pdb,irotam_pdb
- common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,
- & irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,
- & istat,ientin,ientout,izs1,isecpred,ibond,irest2,iifrag,
- & icart,irest1,isccor,ithep_pdb,irotam_pdb
- character*256 outname,intname,pdbname,mol2name,statname,intinname,
- & entname,prefix,secpred,rest2name,qname,cartname,tmpdir,
- & mremd_rst_name,curdir,pref_orig
- character*4 liczba
- common /fnames/ outname,intname,pdbname,mol2name,statname,
- & intinname,entname,prefix,pot,secpred,rest2name,qname,
- & cartname,tmpdir,mremd_rst_name,curdir,pref_orig,liczba
-C CSA I/O units & files
- character*256 csa_rbank,csa_seed,csa_history,csa_bank,
- & csa_bank1,csa_alpha,csa_alpha1,csa_bankt,csa_int,
- & csa_bank_reminimized,csa_native_int,csa_in
- common /csafiles/ csa_rbank,csa_seed,csa_history,csa_bank,
- & csa_bank1,csa_alpha,csa_alpha1,csa_bankt,csa_int,
- & csa_bank_reminimized,csa_native_int,csa_in
- integer icsa_rbank,icsa_seed,icsa_history,icsa_bank,
- & icsa_bank1,icsa_alpha,icsa_alpha1,icsa_bankt,icsa_int,
- & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb
- common /csaunits/ icsa_rbank,icsa_seed,icsa_history,icsa_bank,
- & icsa_bank1,icsa_alpha,icsa_alpha1,icsa_bankt,icsa_int,
- & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb
-C Parameter files
- character*256 bondname,thetname,rotname,torname,tordname,
- & fouriername,elename,sidename,scpname,sccorname,patname,
- & thetname_pdb,rotname_pdb
- common /parfiles/ bondname,thetname,rotname,torname,tordname,
- & fouriername,elename,sidename,scpname,sccorname,patname,
- & thetname_pdb,rotname_pdb
- character*3 pot
-C-----------------------------------------------------------------------
-C INP - main input file
-C IOUT - list file
-C IGEOM - geometry output in the form of virtual-chain internal coordinates
-C INTIN - geometry input (for multiple conformation processing) in int. coords.
-C IPDB - Cartesian-coordinate output in PDB format
-C IMOL2 - Cartesian-coordinate output in Tripos mol2 format
-C IPDBIN - PDB input file
-C ITHEP - virtual-bond torsional angle parametrs
-C IROTAM - side-chain geometry and local-interaction parameters
-C ITORP - torsional parameters
-C ITORDP - double torsional parameters
-C IFOURIER - coefficients of the expansion of local-interaction energy
-C IELEP - electrostatic-interaction parameters
-C ISIDEP - side-chain interaction parameters.
-C ISCPP - SCp interaction parameters.
-C IBOND - virtual-bond constant parameters and moments of inertia.
-C ISCCOR - parameters of the potential of SCCOR term
-C ICBASE - data base with Cartesian coords of known structures.
-C ISTAT - energies and other conf. characteristics from an MCM run.
-C IENTIN - entropy from preceeding simulation(s) to be read in.
-C SECPRED - SECONDARY STRUCTURE PREDICTION for dihedral constraint generation.
-C-----------------------------------------------------------------------
+++ /dev/null
- double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2),
- & fricmat(MAXRES2,MAXRES2),fric_work(MAXRES6),
- & stoch_work(MAXRES6),
- & fricgam(MAXRES6),fricvec(MAXRES2,MAXRES2),
- & pfric_mat(MAXRES2,MAXRES2),vfric_mat(MAXRES2,MAXRES2),
- & afric_mat(MAXRES2,MAXRES2),prand_mat(MAXRES2,MAXRES2),
- & vrand_mat1(MAXRES2,MAXRES2),vrand_mat2(MAXRES2,MAXRES2),
- & pfric0_mat(MAXRES2,MAXRES2,0:maxflag_stoch),
- & afric0_mat(MAXRES2,MAXRES2,0:maxflag_stoch),
- & vfric0_mat(MAXRES2,MAXRES2,0:maxflag_stoch),
- & prand0_mat(MAXRES2,MAXRES2,0:maxflag_stoch),
- & vrand0_mat1(MAXRES2,MAXRES2,0:maxflag_stoch),
- & vrand0_mat2(MAXRES2,MAXRES2,0:maxflag_stoch),
- & mt1(maxres2,maxres2),mt2(maxres2,maxres2),mt3(maxres2,maxres2)
- logical flag_stoch(0:maxflag_stoch)
- common /langforc/ friction,stochforc,
- & fricmat,fric_work,fricgam,stoch_work,fricvec,vrand_mat1,
- & vrand_mat2,prand_mat,vfric_mat,afric_mat,pfric_mat,
- & pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1,
- & vrand0_mat2,flag_stoch
- common /langmat/ mt1,mt2,mt3
+++ /dev/null
- double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2),
- & fricmat(MAXRES2,MAXRES2),fric_work(MAXRES6),
- & stoch_work(MAXRES6),
- & fricgam(MAXRES6),fricvec(MAXRES2,MAXRES2)
- logical flag_stoch(0:maxflag_stoch)
- common /langforc/ friction,stochforc,
- & fricmat,fric_work,fricgam,stoch_work,fricvec,vrand_mat1,
- & vrand_mat2,prand_mat,vfric_mat,afric_mat,pfric_mat,
- & pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1,
- & vrand0_mat2,flag_stoch
- common /langmat/ mt1,mt2,mt3
+++ /dev/null
- double precision a0thet,athet,bthet,polthet,gthet,theta0,sig0,
- & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0
- integer nlob
-C Parameters of the virtual-bond-angle probability distribution
- common /thetas/ a0thet(ntyp),athet(2,ntyp),bthet(2,ntyp),
- & polthet(0:3,ntyp),gthet(3,ntyp),theta0(ntyp),sig0(ntyp),
- & sigc0(ntyp)
-C Parameters of the side-chain probability distribution
- common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp),
- & censc(3,maxlob,ntyp),gaussc(3,3,maxlob,ntyp),dsc0(ntyp1),
- & nlob(ntyp1)
-C Parameters of ab initio-derived potential of virtual-bond-angle bending
- integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble,
- & ithetyp(ntyp1),nntheterm
- double precision aa0thet(maxthetyp1,maxthetyp1,maxthetyp1),
- & aathet(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1),
- & bbthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1),
- & ccthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1),
- & ddthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1),
- & eethet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1),
- & ffthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1,
- & maxthetyp1),
- & ggthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1,
- & maxthetyp1)
- common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet,
- & ffthet,
- & ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,
- & ndouble,nntheterm
-C Virtual-bond lenghts
- double precision vbl,vblinv,vblinv2,vbl_cis,vbl0,vbld_inv
- integer loc_start,loc_end,ithet_start,ithet_end,iphi_start,
- & iphi_end,iphid_start,iphid_end,itau_start,itau_end,ibond_start,
- & ibond_end,
- & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end,
- & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start,
- & iint_end,iphi1_start,iphi1_end,
- & ibond_displ(0:max_fg_procs-1),ibond_count(0:max_fg_procs-1),
- & ithet_displ(0:max_fg_procs-1),ithet_count(0:max_fg_procs-1),
- & iphi_displ(0:max_fg_procs-1),iphi_count(0:max_fg_procs-1),
- & iphi1_displ(0:max_fg_procs-1),iphi1_count(0:max_fg_procs-1),
- & ivec_displ(0:max_fg_procs-1),ivec_count(0:max_fg_procs-1),
- & iset_displ(0:max_fg_procs-1),iset_count(0:max_fg_procs-1),
- & iint_count(0:max_fg_procs-1),iint_displ(0:max_fg_procs-1)
- common /peptbond/ vbl,vblinv,vblinv2,vbl_cis,vbl0
- common /indices/ loc_start,loc_end,ithet_start,ithet_end,
- & iphi_start,iphi_end,iphid_start,iphid_end,itau_start,itau_end,
- & ibond_start,ibond_end,
- & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end,
- & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start,
- & iint_end,iphi1_start,iphi1_end,iint_count,iint_displ,ivec_displ,
- & ivec_count,iset_displ,
- & iset_count,ibond_displ,ibond_count,ithet_displ,ithet_count,
- & iphi_displ,iphi_count,iphi1_displ,iphi1_count
-C Inverses of the actual virtual bond lengths
- common /invlen/ vbld_inv(maxres2)
+++ /dev/null
-c Variables (set in init routine) never modified by local_move
- integer init_called
- logical locmove_output
- double precision min_theta, max_theta
- double precision dmin2,dmax2
- double precision flag,small,small2
-
- common /loc_const/ init_called,locmove_output,min_theta,
- + max_theta,dmin2,dmax2,flag,small,small2
-
-c Workspace for local_move
- integer a_n,b_n,res_n
- double precision a_ang,b_ang,res_ang
- logical a_tab,b_tab,res_tab
-
- common /loc_work/ res_ang(0:11),a_ang(0:7),b_ang(0:3),
- + res_n,res_tab(0:2,0:2,0:11),
- + a_n,a_tab(0:2,0:7),
- + b_n,b_tab(0:2,0:3)
+++ /dev/null
- integer nmap,res1,res2,nstep
- double precision ang_from,ang_to
- common /mapp/ ang_from(maxvar),ang_to(maxvar),nmap,kang(maxvar),
- & res1(maxvar),res2(maxvar),nstep(maxvar)
+++ /dev/null
- double precision
- & gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
- & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
- & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
- & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
- & gsccorx_max,gsclocx_max
- common /maxgrad/
- & gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
- & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
- & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
- & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
- & gsccorx_max,gsclocx_max
+++ /dev/null
- double precision entropy(-max_ene-4:max_ene),nminima(maxsave),
- & nhist(-max_ene:max_ene)
- logical ent_read,multican
- common /mce/ entropy,emin,emax,nhist,nminima,ent_read,multican,
- & indminn,indmaxx
- integer npool
- double precision xpool,epool,pool_fraction
- common /pool/ xpool(maxvar,max_pool),epool(max_pool),
- & pool_fraction,npool
- integer save_frequency,message_frequency,pool_read_freq,
- & pool_save_freq,print_freq
- common /mce_counters/ save_frequency,message_frequency,
- & pool_read_freq,pool_save_freq,print_freq
+++ /dev/null
-C... Following COMMON block contains general variables controlling the MC/MCM
-C... procedure
-c-----------------------------------------------------------------------------
- double precision Tcur,Tmin,Tmax,TstepH,TstepC,RanFract,
- & overlap_cut,e_up,delte
- integer nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter,
- & maxrepm,ngen,ntrial,ntherm,nrepm,neneval,nsave,maxoverlap,
- & nsave_part,max_mcm_it,nsweep,print_mc
- logical print_stat,print_int
- common /mcm/ Tcur,Tmin,Tmax,TstepH,TstepC,Rbol,betbol,RanFract,
- & overlap_cut,e_up,delte,
- & nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter,maxrepm,
- & maxoverlap,ntrial,max_mcm_it,
- & ngen,ntherm,nrepm,neneval,nsave,nsave_part(max_cg_procs),nsweep,
- & print_mc,print_stat,print_int
-c-----------------------------------------------------------------------------
-C... The meaning of the above variables is as follows:
-C... Tcur,Tmin,Tmax - Current,minimum and maximum temperature, respectively;
-C... NstepC,NStepH - Number of cooling and heating steps, respectively;
-C... TstepH,TstepC - factors by which T is multiplied in order to be
-C... increased or decreased.
-C... betbol - Boltzmann's inverse temperature (1/(Rbol*Tcur));
-C... Rbol - the gas constant;
-C... RanFract - the chance that a new conformation will be random-generated;
-C... maxacc - maximum number of accepted conformations;
-C... maxgen,ngen - Maximum and current number of generated conformations;
-C... maxtrial,ntrial - maximum number of trials before temperature is increased
-C... and current number of trials, respectively;
-C... maxrepm,nrepm - maximum number of allowed minima repetition and current
-C... number of minima repetitions, respectively;
-C... maxoverlap - max. # of overlapping confs generated in a single iteration;
-C... neneval - number of energy evaluations;
-C... nsave - number of confs. in the backup array;
-C... nsweep - the number of macroiterations in generating the distributions.
-c------------------------------------------------------------------------------
-C... Following COMMON block contains variables controlling motion.
-c------------------------------------------------------------------------------
- double precision sumpro_type,sumpro_bond
- integer koniecl, Nbm,MaxSideMove,nmove,moves(-1:MaxMoveType+1),
- & moves_acc(-1:MaxMoveType+1),nacc_tot,nacc_part(0:MaxProcs)
- common /move/ sumpro_type(0:MaxMoveType),sumpro_bond(0:maxres),
- & koniecl,Nbm,MaxSideMove,nmove,nbond_move(maxres),
- & nbond_acc(maxres),moves,moves_acc
- common /accept_stats/ nacc_tot,nacc_part
- integer nwindow,winstart,winend,winlen
- common /windows/ nwindow,winstart(maxres),winend(maxres),
- & winlen(maxres)
- character*16 MovTypID
- common /moveID/ MovTypID(-1:MaxMoveType+1)
-c------------------------------------------------------------------------------
-C... koniecl - the number of bonds to be considered "end bonds" subjected to
-C... end moves;
-C... Nbm - The maximum length of N-bond segment to be moved;
-C... MaxSideMove - maximum number of side chains subjected to local moves
-C... simultaneously;
-C... nmove - the current number of attempted moves;
-C... nbond_move(*) array that stores the total numbers of 2-bond,3-bond,...
-C... moves;
-C... nendmove - number of endmoves;
-C... nbackmove - number of backbone moves;
-C... nsidemove - number of local side chain moves;
-C... sumpro_type(*) - array that stores the lower and upper boundary of the
-C... random-number range that determines the type of move
-C... (N-bond, backbone or side chain);
-C... sumpro_bond(*) - array that stores the probabilities to perform bond
-C... moves of consecutive segment length.
-C... winstart(*) - the starting position of the perturbation window;
-C... winend(*) - the end position of the perturbation window;
-C... winlen(*) - length of the perturbation window;
-C... nwindow - the number of perturbation windows (0 - entire chain).
+++ /dev/null
- double precision gcart, gxcart, gradcag,gradxag
- common /mdgrad/ gcart(3,0:MAXRES), gxcart(3,0:MAXRES),
- & gradcag(3,MAXRES),gradxag(3,MAXRES)
- integer dimen,dimen1, dimen3, ifrag(2,50,maxprocs/20),
- & ipair(2,100,maxprocs/20),iset,
- & mset(maxprocs/20),nset
- double precision IP,ISC(ntyp+1),mp,
- & msc(ntyp+1),d_t_work(MAXRES6),
- & d_t_work_new(MAXRES6),d_t(3,0:MAXRES2),d_t_new(3,0:MAXRES2),
- & d_af_work(MAXRES6),d_as_work(MAXRES6),
- & d_t_old(3,0:MAXRES2),d_a_old(3,0:MAXRES2),d_a_short(3,0:MAXRES2),
- & Gmat(MAXRES2,MAXRES2),Ginv(MAXRES2,MAXRES2),A(MAXRES2,MAXRES2),
- & d_a(3,0:MAXRES2),d_a_work(6*MAXRES),kinetic_force(MAXRES6),
- & Gsqrp(MAXRES2,MAXRES2),Gsqrm(MAXRES2,MAXRES2),
- & vtot(MAXRES2),Gvec(maxres2,maxres2),Geigen(maxres2)
-
- real*8 sigma_dih(799,19), odl(799,799,19), dih(799,19),
- & sigma_odl(799,799,19)
-
- double precision v_ini,d_time,d_time0,t_bath,tau_bath,
- & EK,potE,potEcomp(0:n_ene+4),totE,totT,amax,kinetic_T,dvmax,damax,
- & edriftmax,
- & eq_time,wfrag(50,maxprocs/20),wpair(100,maxprocs/20),
- & qfrag(50),qpair(100),
- & qinfrag(50,maxprocs/20),qinpair(100,maxprocs/20),
- & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst,ehomology_constr,
- & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES),
- & utheta(maxfrag_back),ugamma(maxfrag_back),uscdiff(maxfrag_back),
- & dutheta(maxres),dugamma(maxres),duscdiff(3,maxres),
- & duscdiffx(3,maxres),wfrag_back(3,maxfrag_back,maxprocs/20),
- & uconst_back
- integer n_timestep,ntwx,ntwe,lang,count_reset_moment,
- & count_reset_vel,reset_fricmat,nfrag,npair,nfrag_back,
- & ifrag_back(3,maxfrag_back,maxprocs/20),ntime_split,ntime_split0,
- & maxtime_split, lim_odl, lim_dih
- integer nresn,nyosh,nnos
- double precision glogs,qmass,vlogs,xlogs
- logical large,print_compon,tbf,rest,reset_moment,reset_vel,
- & surfarea,rattle,usampl,mdpdb,RESPA,tnp,tnp1,tnh,xiresp
- integer igmult_start,igmult_end,my_ng_count,ng_start,ng_counts,
- & nginv_start,nginv_counts,myginv_ng_count
- common /back_constr/ uconst_back,utheta,ugamma,uscdiff,
- & dutheta,dugamma,duscdiff,duscdiffx,lim_odl,lim_dih,
- & wfrag_back,nfrag_back,ifrag_back,odl,dih,sigma_dih,sigma_odl
- common /qmeas/ qfrag,qpair,qinfrag,qinpair,wfrag,wpair,eq_time,
- & Ucdfrag,Ucdpair,dUdconst,dUdxconst,dqwol,dxqwol,Uconst,
- & iset,mset,nset,usampl,ifrag,ipair,npair,nfrag
- common /mdpar/ v_ini,d_time,d_time0,scal_fric,
- & t_bath,tau_bath,dvmax,damax,n_timestep,mdpdb,
- & ntime_split,ntime_split0,maxtime_split,
- & ntwx,ntwe,large,print_compon,tbf,rest,tnp,tnp1,tnh
- common /MDcalc/ totT,totE,potE,potEcomp,EK,amax,edriftmax,
- & kinetic_T
- common /lagrange/ d_t,d_t_old,d_t_new,d_t_work,
- & d_t_work_new,d_a,d_a_old,d_a_work,d_af_work,d_as_work,d_a_short,
- & kinetic_force,
- & A,Ginv,Gmat,Gvec,Geigen,Gsqrp,Gsqrm,
- & vtot,dimen,dimen1,dimen3,lang,
- & reset_moment,reset_vel,count_reset_moment,count_reset_vel,
- & rattle,RESPA
- common /inertia/ IP,ISC,MP,MSC
- double precision scal_fric,rwat,etawat,gamp,
- & gamsc(ntyp),stdfp,stdfsc(ntyp),stdforcp(MAXRES),
- & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb
- common /langevin/ pstok,restok,gamp,gamsc,
- & stdfp,stdfsc,stdforcp,stdforcsc,rwat,etawat,cPoise,Rb,surfarea,
- & reset_fricmat
- common /mdpmpi/ igmult_start,igmult_end,my_ng_count,
- & myginv_ng_count,
- & ng_start(0:MaxProcs-1),ng_counts(0:MaxProcs-1),
- & nginv_start(0:MaxProcs),nginv_counts(0:MaxProcs-1)
- double precision pi_np,pistar,s_np,s12_np,Q_np,E_old,H0,E_long,
- & sold_np,d_t_half,Csplit,hhh
- common /nosepoincare/ pi_np,pistar,s_np,s12_np,Q_np,E_old,H0,
- & E_long,sold_np,d_t_half(3,0:MAXRES2),Csplit,hhh
- common /nosehoover/ glogs(maxmnh),qmass(maxmnh),
- & vlogs(maxmnh),xlogs(maxmnh),
- & nresn,nyosh,nnos,xiresp
- integer hmc,hmc_acc
- double precision dc_hmc,hmc_etot,totThmc
- common /hmc_md/ dc_hmc(3,0:maxres2),hmc_etot,totThmc,hmc,hmc_acc
+++ /dev/null
- double precision tolf,rtolf
- integer maxfun,maxmin,minfun,minmin,
- & print_min_ini,print_min_stat,print_min_res
- common /minimm/ tolf,rtolf,maxfun,maxmin,minfun,minmin,
- & print_min_ini,print_min_stat,print_min_res
+++ /dev/null
- double precision emuca(4*maxres),nemuca(4*maxres),
- & nemuca2(4*maxres),elow,ehigh,factor,
- & elowi(maxprocs),ehighi(maxprocs),hbin,
- & hist(4*maxres),factor_min
- integer nmuca,imtime,muca_smooth
- common /double_muca/ emuca,nemuca,
- & nemuca2,elow,ehigh,factor,hbin,hist,factor_min
- common /integer_muca/ nmuca,imtime,muca_smooth
- common /mucarem/ elowi,ehighi
-
+++ /dev/null
- character*3 restyp
- character*1 onelet
- common /names/ restyp(ntyp+1),onelet(ntyp+1)
- character*10 ename,wname
- integer nprint_ene,print_order
- common /namterm/ ename(n_ene),wname(n_ene),nprint_ene,
- & print_order(n_ene)
+++ /dev/null
- integer nrep,nstex,hremd
- logical remd_tlist,remd_mlist,mremdsync,restart1file,traj1file
- double precision retmin,retmax,remd_t(maxprocs)
- double precision hweights(maxprocs/20,n_ene)
- integer remd_m(maxprocs),i_sync_step
- integer*2 i2rep(0:maxprocs),i2set(0:maxprocs)
- integer*2 ifirst(maxprocs)
- integer*2 nupa(0:maxprocs/4,0:maxprocs),
- & ndowna(0:maxprocs/4,0:maxprocs)
- real t_restart1(5,maxprocs)
- integer iset_restart1(maxprocs)
- logical t_exchange_only
- common /remdcommon/ nrep,nstex,retmin,retmax,remd_t,remd_tlist,
- & remd_mlist,remd_m,mremdsync,restart1file,
- & traj1file,i_sync_step,t_exchange_only
- common /hamilt_remd/ hweights,hremd
- common /remdrestart/ i2rep,i2set,ifirst,nupa,ndowna,t_restart1,
- & iset_restart1
- real totT_cache,EK_cache,potE_cache,t_bath_cache,Uconst_cache,
- & qfrag_cache,qpair_cache,c_cache,uscdiff_cache,
- & ugamma_cache,utheta_cache
- integer ntwx_cache,ii_write,max_cache_traj_use
- common /traj1cache/ totT_cache(max_cache_traj),
- & EK_cache(max_cache_traj),
- & potE_cache(max_cache_traj),
- & t_bath_cache(max_cache_traj),
- & Uconst_cache(max_cache_traj),
- & qfrag_cache(50,max_cache_traj),
- & qpair_cache(100,max_cache_traj),
- & ugamma_cache(maxfrag_back,max_cache_traj),
- & utheta_cache(maxfrag_back,max_cache_traj),
- & uscdiff_cache(maxfrag_back,max_cache_traj),
- & c_cache(3,maxres2+2,max_cache_traj),
- & iset_cache(max_cache_traj),ntwx_cache,
- & ii_write,max_cache_traj_use
-
+++ /dev/null
- double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss
- integer ns,nss,nfree,iss
- common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,
- & ns,nss,nfree,iss(maxss)
- double precision dhpb,dhpb1,forcon
- integer ihpb,jhpb,nhpb,idssb,jdssb
- common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim),
- & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),nhpb
- double precision weidis
- common /restraints/ weidis
- integer link_start,link_end
- common /links_split/ link_start,link_end
- double precision Ht,dyn_ssbond_ij
- logical dyn_ss,dyn_ss_mask
- common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres),
- & idssb(maxdim),jdssb(maxdim),
- & Ht,dyn_ss,dyn_ss_mask(maxres)
+++ /dev/null
-cc Parameters of the SCCOR term
- double precision v1sccor,v2sccor,vlor1sccor,
- & vlor2sccor,vlor3sccor,gloc_sc,
- & dcostau,dsintau,dtauangle,dcosomicron,
- & domicron,v0sccor
- integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor
- common/sccor/v1sccor(maxterm_sccor,3,20,20),
- & v2sccor(maxterm_sccor,3,20,20),
- & vlor1sccor(maxterm_sccor,20,20),
- & vlor2sccor(maxterm_sccor,20,20),
- & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,0:maxres2,10),
- & v0sccor(ntyp,ntyp),
- & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2),
- & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2),
- & domicron(3,3,3,maxres2),
- & nterm_sccor(ntyp,ntyp),isccortyp(ntyp),nsccortyp,
- & nlor_sccor(ntyp,ntyp)
+++ /dev/null
-C Parameters of the SC rotamers (local) term
- double precision sc_parmin
- common/scrot/sc_parmin(maxsccoef,20)
+++ /dev/null
- integer king,idint,idreal,idchar,is_done
- parameter (king=0,idint=1105,idreal=1729,idchar=1597,is_done=1)
- integer me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,kolor,
- & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1),CG_COMM,FG_COMM,
- & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp(0:maxprocs-1),
- & kolor1,key1,nfgtasks1,MyRank,
- & max_gs_size
- logical yourjob, finished, cgdone
- common/setup/me,MyRank,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,
- & nfgtasks,nfgtasks1,
- & max_gs_size,kolor,koniec,WhatsUp,ifinish,CG_COMM,FG_COMM,
- & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp
- integer MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2,
- & MPI_THET,MPI_GAM,
- & MPI_ROTAT1(0:1),MPI_ROTAT2(0:1),MPI_ROTAT_OLD(0:1),
- & MPI_PRECOMP11(0:1),MPI_PRECOMP12(0:1),MPI_PRECOMP22(0:1),
- & MPI_PRECOMP23(0:1)
- common /types/ MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2,
- & MPI_THET,MPI_GAM,
- & MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,MPI_PRECOMP11,MPI_PRECOMP12,
- & MPI_PRECOMP22,MPI_PRECOMP23
+++ /dev/null
- double precision r_cut,rlamb
- common /splitele/ r_cut,rlamb
+++ /dev/null
- integer nthread,nexcl,iexam,ipatt
- double precision ener0,ener,max_time_for_thread,
- & ave_time_for_thread
- common /thread/ nthread,nexcl,iexam(2,maxthread),
- & ipatt(2,maxthread)
- common /thread1/ ener0(n_ene+2,maxthread),ener(n_ene+2,maxthread),
- & max_time_for_thread,ave_time_for_thread
+++ /dev/null
- DOUBLE PRECISION BATIME,TIMLIM,STIME,PREVTIM,SAFETY
- DOUBLE PRECISION WALLTIME
- INTEGER ISTOP
-c FOUND_NAN - set by calcf to stop sumsl via stopx
- logical FOUND_NAN
- COMMON/TIME1/STIME,TIMLIM,BATIME,PREVTIM,SAFETY,WALLTIME
- COMMON/STOPTIM/ISTOP
- common /sumsl_flag/ FOUND_NAN
- double precision t_init,t_MDsetup,t_langsetup,t_MD,
- & t_enegrad,t_sdsetup,time_bcast,time_reduce,time_gather,
- & time_sendrecv,time_barrier_e,time_barrier_g,time_scatter,
- & t_eelecij,time_bcast7,time_bcastc,time_bcastw,time_allreduce,
- & time_enecalc,time_sumene,time_lagrangian,time_cartgrad,
- & time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart,
- & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric,
- & time_scatter_fmat,time_scatter_ginv,
- & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult,
- & time_stoch,t_eshort,t_elong,t_etotal
- common /timing/ t_init,t_MDsetup,t_langsetup,
- & t_MD,t_enegrad,t_sdsetup,time_bcast,time_reduce,time_gather,
- & time_sendrecv,time_scatter,time_barrier_e,time_barrier_g,
- & time_bcast7,time_bcastc,time_bcastw,time_allreduce,
- & t_eelecij,time_enecalc,time_sumene,time_lagrangian,time_cartgrad,
- & time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart,
- & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric,
- & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult,
- & time_scatter_fmat,time_scatter_ginv,
- & time_stoch,t_eshort,t_elong,t_etotal
+++ /dev/null
- integer ndih_constr,idih_constr(maxdih_constr)
- integer ndih_nconstr,idih_nconstr(maxdih_constr)
- integer idihconstr_start,idihconstr_end
- double precision phi0(maxdih_constr),drange(maxdih_constr),ftors
- common /torcnstr/ phi0,drange,ftors,ndih_constr,idih_constr,
- & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end
+++ /dev/null
-C Torsional constants of the rotation about virtual-bond dihedral angles
- double precision v1,v2,vlor1,vlor2,vlor3,v0
- integer itortyp,ntortyp,nterm,nlor,nterm_old
- common/torsion/v0(maxtor,maxtor),v1(maxterm,maxtor,maxtor),
- & v2(maxterm,maxtor,maxtor),vlor1(maxlor,maxtor,maxtor),
- & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor),
- & itortyp(ntyp),ntortyp,nterm(maxtor,maxtor),nlor(maxtor,maxtor)
- & ,nterm_old
-C 6/23/01 - constants for double torsionals
- double precision v1c,v1s,v2c,v2s
- integer ntermd_1,ntermd_2
- common /torsiond/ v1c(2,maxtermd_1,maxtor,maxtor,maxtor),
- & v1s(2,maxtermd_1,maxtor,maxtor,maxtor),
- & v2c(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor),
- & v2s(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor),
- & ntermd_1(maxtor,maxtor,maxtor),ntermd_2(maxtor,maxtor,maxtor)
-C 9/18/99 - added Fourier coeffficients of the expansion of local energy
-C surface
- double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde
- integer nloctyp
- common/fourier/ b1(2,maxtor),b2(2,maxtor),cc(2,2,maxtor),
- & dd(2,2,maxtor),ee(2,2,maxtor),ctilde(2,2,maxtor),
- & dtilde(2,2,maxtor),b1tilde(2,maxtor),nloctyp
+++ /dev/null
-C Store the geometric variables in the following COMMON block.
- integer ntheta,nphi,nside,nvar,Origin,nstore,ialph,ivar,
- & mask_theta,mask_phi,mask_side
- double precision theta,phi,alph,omeg,varsave,esave,varall,vbld,
- & thetaref,phiref,costtab,sinttab,cost2tab,sint2tab,
- & xxtab,yytab,zztab,xxref,yyref,zzref,tauangle,omicron
- common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres),
- & omicron(2,maxres),tauangle(3,maxres),
- & vbld(2*maxres),thetaref(maxres),phiref(maxres),
- & costtab(maxres), sinttab(maxres), cost2tab(maxres),
- & sint2tab(maxres),xxtab(maxres),yytab(maxres),
- & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres),
- & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar
-C Store the angles and variables corresponding to old conformations (for use
-C in MCM).
- common /oldgeo/ varsave(maxvar,maxsave),esave(maxsave),
- & Origin(maxsave),nstore
-C freeze some variables
- logical mask_r
- common /restr/ varall(maxvar),mask_r,mask_theta(maxres),
- & mask_phi(maxres),mask_side(maxres)
+++ /dev/null
- common /vectors/ uy(3,maxres),uz(3,maxres),
- & uygrad(3,3,2,maxres),uzgrad(3,3,2,maxres)
-
+++ /dev/null
-********************************************************************************
-* Settings for the program of united-residue peptide simulation in real space *
-* *
-* ------- As of 6/23/01 ----------- *
-* *
-********************************************************************************
-C Max. number of processors.
- integer maxprocs
- parameter (maxprocs=2048)
-C Max. number of fine-grain processors
- integer max_fg_procs
-c parameter (max_fg_procs=maxprocs)
- parameter (max_fg_procs=512)
-C Max. number of coarse-grain processors
- integer max_cg_procs
- parameter (max_cg_procs=maxprocs)
-C Max. number of AA residues
- integer maxres
- parameter (maxres=800)
-C Appr. max. number of interaction sites
- integer maxres2,maxres6,mmaxres2
- parameter (maxres2=2*maxres,maxres6=6*maxres)
- parameter (mmaxres2=(maxres2*(maxres2+1)/2))
-C Max. number of variables
- integer maxvar
- parameter (maxvar=6*maxres)
-C Max. number of groups of interactions that a given SC is involved in
- integer maxint_gr
- parameter (maxint_gr=2)
-C Max. number of derivatives of virtual-bond and side-chain vectors in theta
-C or phi.
- integer maxdim
- parameter (maxdim=(maxres-1)*(maxres-2)/2)
-C Max. number of SC contacts
- integer maxcont
- parameter (maxcont=12*maxres)
-C Max. number of contacts per residue
- integer maxconts
- parameter (maxconts=maxres/4)
-c parameter (maxconts=50)
-C Number of AA types (at present only natural AA's will be handled
- integer ntyp,ntyp1
- parameter (ntyp=20,ntyp1=ntyp+1)
-C Max. number of types of dihedral angles & multiplicity of torsional barriers
-C and the number of terms in double torsionals
- integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2
- parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8)
-C Max. number of residue types and parameters in expressions for
-C virtual-bond angle bending potentials
- integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3,
- & maxsingle,maxdouble,mmaxtheterm
- parameter (maxthetyp=3,maxthetyp1=maxthetyp+1,maxtheterm=20,
- & maxtheterm2=6,maxtheterm3=4,maxsingle=6,maxdouble=4,
- & mmaxtheterm=maxtheterm)
-c Max number of torsional terms in SCCOR
- integer maxterm_sccor
- parameter (maxterm_sccor=6)
-C Max. number of lobes in SC distribution
- integer maxlob
- parameter (maxlob=4)
-C Max. number of S-S bridges
- integer maxss
- parameter (maxss=20)
-C Max. number of dihedral angle constraints
- integer maxdih_constr
- parameter (maxdih_constr=maxres)
-C Max. number of patterns in the pattern database
- integer maxseq
- parameter (maxseq=10)
-C Max. number of residues in a peptide in the database
- integer maxres_base
- parameter (maxres_base=10)
-C Max. number of threading attempts
- integer maxthread
- parameter (maxthread=20)
-C Max. number of move types in MCM
- integer maxmovetype
- parameter (maxmovetype=4)
-C Max. number of stored confs. in MC/MCM simulation
- integer maxsave
- parameter (maxsave=20)
-C Max. number of energy intervals
- integer max_ene
- parameter (max_ene=10)
-C Max. number of conformations in Master's cache array
- integer max_cache
- parameter (max_cache=10)
-C Max. number of conformations in the pool
- integer max_pool
- parameter (max_pool=10)
-C Number of energy components
- integer n_ene,n_ene2
- parameter (n_ene=24,n_ene2=2*n_ene)
-C Number of threads in deformation
- integer max_thread,max_thread2
- parameter (max_thread=4,max_thread2=2*max_thread)
-C Number of structures to compare at t=0
- integer max_threadss,max_threadss2
- parameter (max_threadss=8,max_threadss2=2*max_threadss)
-C Maxmimum number of angles per residue
- integer mxang
- parameter (mxang=4)
-C Maximum number of groups of angles
- integer mxgr
- parameter (mxgr=2*maxres)
-C Maximum number of chains
- integer mxch
- parameter (mxch=1)
-csaC Maximum number of generated conformations
-csa integer mxio
-csa parameter (mxio=2)
-csaC Maximum number of n7 generated conformations
-csa integer mxio2
-csa parameter (mxio2=2)
-csaC Maximum number of moves (n1-n8)
-csa integer mxmv
-csa parameter (mxmv=18)
-csaC Maximum number of seed
-csa integer max_seed
-csa parameter (max_seed=1)
-C Maximum number of timesteps for which stochastic MD matrices can be stored
- integer maxflag_stoch
- parameter (maxflag_stoch=0)
-C Maximum number of backbone fragments in restraining
- integer maxfrag_back
- parameter (maxfrag_back=4)
-C Maximum number of SC local term fitting function coefficiants
- integer maxsccoef
- parameter (maxsccoef=65)
-C Maximum number of terms in SC bond-stretching potential
- integer maxbondterm
- parameter (maxbondterm=3)
-C Maximum number of conformation stored in cache on each CPU before sending
-C to master; depends on nstex / ntwx ratio
- integer max_cache_traj
- parameter (max_cache_traj=10)
-C Nose-Hoover chain - chain length and order of Yoshida algorithm
- integer maxmnh,maxyosh
- parameter(maxmnh=10,maxyosh=5)
+++ /dev/null
-********************************************************************************
-* Settings for the program of united-residue peptide simulation in real space *
-* *
-* ------- As of 6/23/01 ----------- *
-* *
-********************************************************************************
-C Max. number of processors.
- parameter (maxprocs=2100)
-C Max. number of fine-grain processors
- parameter (max_fg_procs=maxprocs)
-C Max. number of coarse-grain processors
- parameter (max_cg_procs=maxprocs)
-C Max. number of AA residues
- parameter (maxres=150)
-C Appr. max. number of interaction sites
- parameter (maxres2=2*maxres,maxres6=6*maxres)
- parameter (mmaxres6=(maxres6*(maxres6+1)/2))
-C Max. number of variables
- parameter (maxvar=6*maxres)
-C Max. number of groups of interactions that a given SC is involved in
- parameter (maxint_gr=2)
-C Max. number of derivatives of virtual-bond and side-chain vectors in theta
-C or phi.
- parameter (maxdim=(maxres-1)*(maxres-2)/2)
-C Max. number of SC contacts
- parameter (maxcont=12*maxres)
-C Max. number of contacts per residue
- parameter (maxconts=maxres)
-C Number of AA types (at present only natural AA's will be handled
- parameter (ntyp=20,ntyp1=ntyp+1)
-C Max. number of types of dihedral angles & multiplicity of torsional barriers
-C and the number of terms in double torsionals
- parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8)
-C Max. number of lobes in SC distribution
- parameter (maxlob=4)
-C Max. number of S-S bridges
- parameter (maxss=20)
-C Max. number of dihedral angle constraints
- parameter (maxdih_constr=maxres)
-C Max. number of patterns in the pattern database
- parameter (maxseq=10)
-C Max. number of residues in a peptide in the database
- parameter (maxres_base=10)
-C Max. number of threading attempts
- parameter (maxthread=20)
-C Max. number of move types in MCM
- parameter (maxmovetype=4)
-C Max. number of stored confs. in MC/MCM simulation
- parameter (maxsave=20)
-C Max. number of energy intervals
- parameter (max_ene=10)
-C Max. number of conformations in Master's cache array
- parameter (max_cache=10)
-C Max. number of conformations in the pool
- parameter (max_pool=10)
-C Number of energy components
- parameter (n_ene=22,n_ene2=2*n_ene)
-C Number of threads in deformation
- integer max_thread,max_thread2
- parameter (max_thread=4,max_thread2=2*max_thread)
-C Number of structures to compare at t=0
- integer max_threadss,max_threadss2
- parameter (max_threadss=8,max_threadss2=2*max_threadss)
-C Maxmimum number of angles per residue
- parameter (mxang=4)
-C Maximum number of groups of angles
- parameter (mxgr=2*maxres)
-C Maximum number of chains
- parameter (mxch=1)
-C Maximum number of generated conformations
- parameter (mxio=2)
-C Maximum number of n7 generated conformations
- parameter (mxio2=2)
-C Maximum number of moves (n1-n8)
- parameter (mxmv=18)
-C Maximum number of seed
- parameter (max_seed=1)
-C Maximum number of timesteps for which stochastic MD matrices can be stored
- integer maxflag_stoch
- parameter (maxflag_stoch=0)
+++ /dev/null
-********************************************************************************
-* Settings for the program of united-residue peptide simulation in real space *
-* *
-* ------- As of 6/23/01 ----------- *
-* *
-********************************************************************************
-C Max. number of processors.
- parameter (maxprocs=4100)
-C Max. number of fine-grain processors
- parameter (max_fg_procs=maxprocs)
-C Max. number of coarse-grain processors
- parameter (max_cg_procs=maxprocs)
-C Max. number of AA residues
- parameter (maxres=150)
-C Appr. max. number of interaction sites
- parameter (maxres2=2*maxres,maxres6=6*maxres)
- parameter (mmaxres6=(maxres6*(maxres6+1)/2))
-C Max. number of variables
- parameter (maxvar=6*maxres)
-C Max. number of groups of interactions that a given SC is involved in
- parameter (maxint_gr=2)
-C Max. number of derivatives of virtual-bond and side-chain vectors in theta
-C or phi.
- parameter (maxdim=(maxres-1)*(maxres-2)/2)
-C Max. number of SC contacts
- parameter (maxcont=12*maxres)
-C Max. number of contacts per residue
- parameter (maxconts=maxres)
-C Number of AA types (at present only natural AA's will be handled
- parameter (ntyp=20,ntyp1=ntyp+1)
-C Max. number of types of dihedral angles & multiplicity of torsional barriers
-C and the number of terms in double torsionals
- parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8)
-C Max. number of lobes in SC distribution
- parameter (maxlob=4)
-C Max. number of S-S bridges
- parameter (maxss=20)
-C Max. number of dihedral angle constraints
- parameter (maxdih_constr=maxres)
-C Max. number of patterns in the pattern database
- parameter (maxseq=10)
-C Max. number of residues in a peptide in the database
- parameter (maxres_base=10)
-C Max. number of threading attempts
- parameter (maxthread=20)
-C Max. number of move types in MCM
- parameter (maxmovetype=4)
-C Max. number of stored confs. in MC/MCM simulation
- parameter (maxsave=20)
-C Max. number of energy intervals
- parameter (max_ene=10)
-C Max. number of conformations in Master's cache array
- parameter (max_cache=10)
-C Max. number of conformations in the pool
- parameter (max_pool=10)
-C Number of energy components
- parameter (n_ene=22,n_ene2=2*n_ene)
-C Number of threads in deformation
- integer max_thread,max_thread2
- parameter (max_thread=4,max_thread2=2*max_thread)
-C Number of structures to compare at t=0
- integer max_threadss,max_threadss2
- parameter (max_threadss=8,max_threadss2=2*max_threadss)
-C Maxmimum number of angles per residue
- parameter (mxang=4)
-C Maximum number of groups of angles
- parameter (mxgr=2*maxres)
-C Maximum number of chains
- parameter (mxch=1)
-C Maximum number of generated conformations
- parameter (mxio=2)
-C Maximum number of n7 generated conformations
- parameter (mxio2=2)
-C Maximum number of moves (n1-n8)
- parameter (mxmv=18)
-C Maximum number of seed
- parameter (max_seed=1)
-C Maximum number of timesteps for which stochastic MD matrices can be stored
- integer maxflag_stoch
- parameter (maxflag_stoch=0)
+++ /dev/null
- subroutine MD
-c------------------------------------------------
-c The driver for molecular dynamics subroutines
-c------------------------------------------------
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
- integer IERROR,ERRCODE
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision cm(3),L(3),vcm(3)
-#ifdef VOUT
- double precision v_work(maxres6),v_transf(maxres6)
-#endif
- integer ilen,rstcount
- external ilen
- character*50 tytul
- common /gucio/ cm
- integer itime
-c
-#ifdef MPI
- if (ilen(tmpdir).gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_"
- & //liczba(:ilen(liczba))//'.rst')
-#else
- if (ilen(tmpdir).gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_"//'.rst')
-#endif
- t_MDsetup=0.0d0
- t_langsetup=0.0d0
- t_MD=0.0d0
- t_enegrad=0.0d0
- t_sdsetup=0.0d0
- write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started"
-#ifdef MPI
- tt0=MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
-c Determine the inverse of the inertia matrix.
- call setup_MD_matrices
-c Initialize MD
- call init_MD
-#ifdef MPI
- t_MDsetup = MPI_Wtime()-tt0
-#else
- t_MDsetup = tcpu()-tt0
-#endif
- rstcount=0
-c Entering the MD loop
-#ifdef MPI
- tt0 = MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
- if (lang.eq.2 .or. lang.eq.3) then
-#ifndef LANG0
- call setup_fricmat
- if (lang.eq.2) then
- call sd_verlet_p_setup
- else
- call sd_verlet_ciccotti_setup
- endif
- do i=1,dimen3
- do j=1,dimen3
- pfric0_mat(i,j,0)=pfric_mat(i,j)
- afric0_mat(i,j,0)=afric_mat(i,j)
- vfric0_mat(i,j,0)=vfric_mat(i,j)
- prand0_mat(i,j,0)=prand_mat(i,j)
- vrand0_mat1(i,j,0)=vrand_mat1(i,j)
- vrand0_mat2(i,j,0)=vrand_mat2(i,j)
- enddo
- enddo
- flag_stoch(0)=.true.
- do i=1,maxflag_stoch
- flag_stoch(i)=.false.
- enddo
-#else
- write (iout,*)
- & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0"
-#ifdef MPI
- call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
-#endif
- stop
-#endif
- else if (lang.eq.1 .or. lang.eq.4) then
- call setup_fricmat
- endif
-#ifdef MPI
- t_langsetup=MPI_Wtime()-tt0
- tt0=MPI_Wtime()
-#else
- t_langsetup=tcpu()-tt0
- tt0=tcpu()
-#endif
- do itime=1,n_timestep
- rstcount=rstcount+1
- if (lang.gt.0 .and. surfarea .and.
- & mod(itime,reset_fricmat).eq.0) then
- if (lang.eq.2 .or. lang.eq.3) then
-#ifndef LANG0
- call setup_fricmat
- if (lang.eq.2) then
- call sd_verlet_p_setup
- else
- call sd_verlet_ciccotti_setup
- endif
- do i=1,dimen3
- do j=1,dimen3
- pfric0_mat(i,j,0)=pfric_mat(i,j)
- afric0_mat(i,j,0)=afric_mat(i,j)
- vfric0_mat(i,j,0)=vfric_mat(i,j)
- prand0_mat(i,j,0)=prand_mat(i,j)
- vrand0_mat1(i,j,0)=vrand_mat1(i,j)
- vrand0_mat2(i,j,0)=vrand_mat2(i,j)
- enddo
- enddo
- flag_stoch(0)=.true.
- do i=1,maxflag_stoch
- flag_stoch(i)=.false.
- enddo
-#endif
- else if (lang.eq.1 .or. lang.eq.4) then
- call setup_fricmat
- endif
- write (iout,'(a,i10)')
- & "Friction matrix reset based on surface area, itime",itime
- endif
- if (reset_vel .and. tbf .and. lang.eq.0
- & .and. mod(itime,count_reset_vel).eq.0) then
- call random_vel
- write(iout,'(a,f20.2)')
- & "Velocities reset to random values, time",totT
- do i=0,2*nres
- do j=1,3
- d_t_old(j,i)=d_t(j,i)
- enddo
- enddo
- endif
- if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then
- call inertia_tensor
- call vcm_vel(vcm)
- do j=1,3
- d_t(j,0)=d_t(j,0)-vcm(j)
- enddo
- call kinetic(EK)
- kinetic_T=2.0d0/(dimen3*Rb)*EK
- scalfac=dsqrt(T_bath/kinetic_T)
- write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT
- do i=0,2*nres
- do j=1,3
- d_t_old(j,i)=scalfac*d_t(j,i)
- enddo
- enddo
- endif
- if (lang.ne.4) then
- if (RESPA) then
-c Time-reversible RESPA algorithm
-c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992)
- call RESPA_step(itime)
- else
-c Variable time step algorithm.
- call velverlet_step(itime)
- endif
- else
-#ifdef BROWN
- call brown_step(itime)
-#else
- print *,"Brown dynamics not here!"
-#ifdef MPI
- call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
-#endif
- stop
-#endif
- endif
- if (ntwe.ne.0) then
- if (mod(itime,ntwe).eq.0) call statout(itime)
-#ifdef VOUT
- do j=1,3
- v_work(j)=d_t(j,0)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- ind=ind+1
- v_work(ind)=d_t(j,i)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- ind=ind+1
- v_work(ind)=d_t(j,i+nres)
- enddo
- endif
- enddo
-
- write (66,'(80f10.5)')
- & ((d_t(j,i),j=1,3),i=0,nres-1),((d_t(j,i+nres),j=1,3),i=1,nres)
- do i=1,ind
- v_transf(i)=0.0d0
- do j=1,ind
- v_transf(i)=v_transf(i)+gvec(j,i)*v_work(j)
- enddo
- v_transf(i)= v_transf(i)*dsqrt(geigen(i))
- enddo
- write (67,'(80f10.5)') (v_transf(i),i=1,ind)
-#endif
- endif
- if (mod(itime,ntwx).eq.0) then
- write (tytul,'("time",f8.2)') totT
- if(mdpdb) then
- call pdbout(potE,tytul,ipdb)
- else
- call cartout(totT)
- endif
- endif
- if (rstcount.eq.1000.or.itime.eq.n_timestep) then
- open(irest2,file=rest2name,status='unknown')
- write(irest2,*) totT,EK,potE,totE,t_bath
- do i=1,2*nres
- write (irest2,'(3e15.5)') (d_t(j,i),j=1,3)
- enddo
- do i=1,2*nres
- write (irest2,'(3e15.5)') (dc(j,i),j=1,3)
- enddo
- close(irest2)
- rstcount=0
- endif
- enddo
-#ifdef MPI
- t_MD=MPI_Wtime()-tt0
-#else
- t_MD=tcpu()-tt0
-#endif
- write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))')
- & ' Timing ',
- & 'MD calculations setup:',t_MDsetup,
- & 'Energy & gradient evaluation:',t_enegrad,
- & 'Stochastic MD setup:',t_langsetup,
- & 'Stochastic MD step setup:',t_sdsetup,
- & 'MD steps:',t_MD
- write (iout,'(/28(1h=),a25,27(1h=))')
- & ' End of MD calculation '
-#ifdef TIMING_ENE
- write (iout,*) "time for etotal",t_etotal," elong",t_elong,
- & " eshort",t_eshort
- write (iout,*) "time_fric",time_fric," time_stoch",time_stoch,
- & " time_fricmatmult",time_fricmatmult," time_fsample ",
- & time_fsample
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine velverlet_step(itime)
-c-------------------------------------------------------------------------------
-c Perform a single velocity Verlet step; the time step can be rescaled if
-c increments in accelerations exceed the threshold
-c-------------------------------------------------------------------------------
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer ierror,ierrcode
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- include 'COMMON.MUCA'
- double precision vcm(3),incr(3)
- double precision cm(3),L(3)
- integer ilen,count,rstcount
- external ilen
- character*50 tytul
- integer maxcount_scale /20/
- common /gucio/ cm
- double precision stochforcvec(MAXRES6)
- common /stochcalc/ stochforcvec
- integer itime
- logical scale
- double precision HNose1,HNose,HNose_nh,H,vtnp(maxres6)
- double precision vtnp_(maxres6),vtnp_a(maxres6)
-c
- scale=.true.
- icount_scale=0
- if (lang.eq.1) then
- call sddir_precalc
- else if (lang.eq.2 .or. lang.eq.3) then
-#ifndef LANG0
- call stochastic_force(stochforcvec)
-#else
- write (iout,*)
- & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0"
-#ifdef MPI
- call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
-#endif
- stop
-#endif
- endif
- itime_scal=0
- do while (scale)
- icount_scale=icount_scale+1
- if (icount_scale.gt.maxcount_scale) then
- write (iout,*)
- & "ERROR: too many attempts at scaling down the time step. ",
- & "amax=",amax,"epdrift=",epdrift,
- & "damax=",damax,"edriftmax=",edriftmax,
- & "d_time=",d_time
- call flush(iout)
-#ifdef MPI
- call MPI_Abort(MPI_COMM_WORLD,IERROR,IERRCODE)
-#endif
- stop
- endif
-c First step of the velocity Verlet algorithm
- if (lang.eq.2) then
-#ifndef LANG0
- call sd_verlet1
-#endif
- else if (lang.eq.3) then
-#ifndef LANG0
- call sd_verlet1_ciccotti
-#endif
- else if (lang.eq.1) then
- call sddir_verlet1
- else if (tnp1) then
- call tnp1_step1
- else if (tnp) then
- call tnp_step1
- else
- if (tnh) then
- call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8)
- do i=0,2*nres
- do j=1,3
- d_t_old(j,i)=d_t_old(j,i)*scale_nh
- enddo
- enddo
- endif
- call verlet1
- endif
-c Build the chain from the newly calculated coordinates
- call chainbuild_cart
- if (rattle) call rattle1
- if (ntwe.ne.0) then
- if (large.and. mod(itime,ntwe).eq.0) then
- write (iout,*) "Cartesian and internal coordinates: step 1"
- call cartprint
- call intout
- write (iout,*) "dC"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3),
- & (dc(j,i+nres),j=1,3)
- enddo
- write (iout,*) "Accelerations"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3),
- & (d_a(j,i+nres),j=1,3)
- enddo
- write (iout,*) "Velocities, step 1"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3),
- & (d_t(j,i+nres),j=1,3)
- enddo
- endif
- endif
-#ifdef MPI
- tt0 = MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
-c Calculate energy and forces
- call zerograd
- call etotal(potEcomp)
-#ifdef TIMING_ENE
-#ifdef MPI
- t_etotal=t_etotal+MPI_Wtime()-tt0
-#else
- t_etotal=t_etotal+tcpu()-tt0
-#endif
-#endif
- E_old=potE
- potE=potEcomp(0)-potEcomp(20)
- call cartgrad
-c Get the new accelerations
- call lagrangian
-#ifdef MPI
- t_enegrad=t_enegrad+MPI_Wtime()-tt0
-#else
- t_enegrad=t_enegrad+tcpu()-tt0
-#endif
-c Determine maximum acceleration and scale down the timestep if needed
- call max_accel
- amax=amax/(itime_scal+1)**2
- call predict_edrift(epdrift)
- if (amax/(itime_scal+1).gt.damax .or. epdrift.gt.edriftmax) then
-c Maximum acceleration or maximum predicted energy drift exceeded, rescale the time step
- scale=.true.
- ifac_time=dmax1(dlog(amax/damax),dlog(epdrift/edriftmax))
- & /dlog(2.0d0)+1
- itime_scal=itime_scal+ifac_time
-c fac_time=dmin1(damax/amax,0.5d0)
- fac_time=0.5d0**ifac_time
- d_time=d_time*fac_time
- if (lang.eq.2 .or. lang.eq.3) then
-#ifndef LANG0
-c write (iout,*) "Calling sd_verlet_setup: 1"
-c Rescale the stochastic forces and recalculate or restore
-c the matrices of tinker integrator
- if (itime_scal.gt.maxflag_stoch) then
- if (large) write (iout,'(a,i5,a)')
- & "Calculate matrices for stochastic step;",
- & " itime_scal ",itime_scal
- if (lang.eq.2) then
- call sd_verlet_p_setup
- else
- call sd_verlet_ciccotti_setup
- endif
- write (iout,'(2a,i3,a,i3,1h.)')
- & "Warning: cannot store matrices for stochastic",
- & " integration because the index",itime_scal,
- & " is greater than",maxflag_stoch
- write (iout,'(2a)')"Increase MAXFLAG_STOCH or use direct",
- & " integration Langevin algorithm for better efficiency."
- else if (flag_stoch(itime_scal)) then
- if (large) write (iout,'(a,i5,a,l1)')
- & "Restore matrices for stochastic step; itime_scal ",
- & itime_scal," flag ",flag_stoch(itime_scal)
- do i=1,dimen3
- do j=1,dimen3
- pfric_mat(i,j)=pfric0_mat(i,j,itime_scal)
- afric_mat(i,j)=afric0_mat(i,j,itime_scal)
- vfric_mat(i,j)=vfric0_mat(i,j,itime_scal)
- prand_mat(i,j)=prand0_mat(i,j,itime_scal)
- vrand_mat1(i,j)=vrand0_mat1(i,j,itime_scal)
- vrand_mat2(i,j)=vrand0_mat2(i,j,itime_scal)
- enddo
- enddo
- else
- if (large) write (iout,'(2a,i5,a,l1)')
- & "Calculate & store matrices for stochastic step;",
- & " itime_scal ",itime_scal," flag ",flag_stoch(itime_scal)
- if (lang.eq.2) then
- call sd_verlet_p_setup
- else
- call sd_verlet_ciccotti_setup
- endif
- flag_stoch(ifac_time)=.true.
- do i=1,dimen3
- do j=1,dimen3
- pfric0_mat(i,j,itime_scal)=pfric_mat(i,j)
- afric0_mat(i,j,itime_scal)=afric_mat(i,j)
- vfric0_mat(i,j,itime_scal)=vfric_mat(i,j)
- prand0_mat(i,j,itime_scal)=prand_mat(i,j)
- vrand0_mat1(i,j,itime_scal)=vrand_mat1(i,j)
- vrand0_mat2(i,j,itime_scal)=vrand_mat2(i,j)
- enddo
- enddo
- endif
- fac_time=1.0d0/dsqrt(fac_time)
- do i=1,dimen3
- stochforcvec(i)=fac_time*stochforcvec(i)
- enddo
-#endif
- else if (lang.eq.1) then
-c Rescale the accelerations due to stochastic forces
- fac_time=1.0d0/dsqrt(fac_time)
- do i=1,dimen3
- d_as_work(i)=d_as_work(i)*fac_time
- enddo
- endif
- if (large) write (iout,'(a,i10,a,f8.6,a,i3,a,i3)')
- & "itime",itime," Timestep scaled down to ",
- & d_time," ifac_time",ifac_time," itime_scal",itime_scal
- else
-c Second step of the velocity Verlet algorithm
- if (lang.eq.2) then
-#ifndef LANG0
- call sd_verlet2
-#endif
- else if (lang.eq.3) then
-#ifndef LANG0
- call sd_verlet2_ciccotti
-#endif
- else if (lang.eq.1) then
- call sddir_verlet2
- else if (tnp1) then
- call tnp1_step2
- else if (tnp) then
- call tnp_step2
- else
- call verlet2
- if (tnh) then
- call kinetic(EK)
- call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8)
- do i=0,2*nres
- do j=1,3
- d_t(j,i)=d_t(j,i)*scale_nh
- enddo
- enddo
- endif
- endif
- if (rattle) call rattle2
- totT=totT+d_time
- if (d_time.ne.d_time0) then
- d_time=d_time0
-#ifndef LANG0
- if (lang.eq.2 .or. lang.eq.3) then
- if (large) write (iout,'(a)')
- & "Restore original matrices for stochastic step"
-c write (iout,*) "Calling sd_verlet_setup: 2"
-c Restore the matrices of tinker integrator if the time step has been restored
- do i=1,dimen3
- do j=1,dimen3
- pfric_mat(i,j)=pfric0_mat(i,j,0)
- afric_mat(i,j)=afric0_mat(i,j,0)
- vfric_mat(i,j)=vfric0_mat(i,j,0)
- prand_mat(i,j)=prand0_mat(i,j,0)
- vrand_mat1(i,j)=vrand0_mat1(i,j,0)
- vrand_mat2(i,j)=vrand0_mat2(i,j,0)
- enddo
- enddo
- endif
-#endif
- endif
- scale=.false.
- endif
- enddo
-c Calculate the kinetic and the total energy and the kinetic temperature
- if (tnp .or. tnp1) then
- do i=0,2*nres
- do j=1,3
- d_t_old(j,i)=d_t(j,i)
- d_t(j,i)=d_t(j,i)/s_np
- enddo
- enddo
- endif
- call kinetic(EK)
- totE=EK+potE
-c diagnostics
-c call kinetic1(EK1)
-c write (iout,*) "step",itime," EK",EK," EK1",EK1
-c end diagnostics
-c Couple the system to Berendsen bath if needed
- if (tbf .and. lang.eq.0) then
- call verlet_bath
- endif
- kinetic_T=2.0d0/(dimen3*Rb)*EK
-c Backup the coordinates, velocities, and accelerations
- do i=0,2*nres
- do j=1,3
- dc_old(j,i)=dc(j,i)
- if(.not.(tnp .or. tnp1)) d_t_old(j,i)=d_t(j,i)
- d_a_old(j,i)=d_a(j,i)
- enddo
- enddo
- if (ntwe.ne.0) then
- if (mod(itime,ntwe).eq.0) then
-
- if(tnp .or. tnp1) then
- HNose1=Hnose(EK,s_np,potE,pi_np,Q_np,t_bath,dimen3)
- H=(HNose1-H0)*s_np
-cd write (iout,'(a,10f)') "hhh",EK,s_np,potE,pi_np,H0
-cd & ,EK+potE+pi_np**2/(2*Q_np)+dimen3*0.001986d0*t_bath*log(s_np)
-cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0
- hhh=h
- endif
-
- if(tnh) then
- HNose1=Hnose_nh(EK,potE)
- H=HNose1-H0
- hhh=h
-cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0
- endif
-
- if (large) then
- itnp=0
- do j=1,3
- itnp=itnp+1
- vtnp(itnp)=d_t(j,0)
- enddo
- do i=nnt,nct-1
- do j=1,3
- itnp=itnp+1
- vtnp(itnp)=d_t(j,i)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- itnp=itnp+1
- vtnp(itnp)=d_t(j,inres)
- enddo
- endif
- enddo
-
-c Transform velocities from UNRES coordinate space to cartesian and Gvec
-c eigenvector space
-
- do i=1,dimen3
- vtnp_(i)=0.0d0
- vtnp_a(i)=0.0d0
- do j=1,dimen3
- vtnp_(i)=vtnp_(i)+Gvec(j,i)*vtnp(j)
- vtnp_a(i)=vtnp_a(i)+A(i,j)*vtnp(j)
- enddo
- vtnp_(i)=vtnp_(i)*dsqrt(geigen(i))
- enddo
-
- do i=1,dimen3
- write (iout,'("WWW",i3,3f10.5)') i,vtnp(i),vtnp_(i),vtnp_a(i)
- enddo
-
- write (iout,*) "Velocities, step 2"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3),
- & (d_t(j,i+nres),j=1,3)
- enddo
- endif
- endif
- endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine RESPA_step(itime)
-c-------------------------------------------------------------------------------
-c Perform a single RESPA step.
-c-------------------------------------------------------------------------------
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer IERROR,ERRCODE
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision energia_short(0:n_ene),
- & energia_long(0:n_ene)
- double precision cm(3),L(3),vcm(3),incr(3)
- double precision dc_old0(3,0:maxres2),d_t_old0(3,0:maxres2),
- & d_a_old0(3,0:maxres2)
- integer ilen,count,rstcount
- external ilen
- character*50 tytul
- integer maxcount_scale /10/
- common /gucio/ cm,energia_short
- double precision stochforcvec(MAXRES6)
- common /stochcalc/ stochforcvec
- integer itime
- logical scale
- double precision vtnp(maxres6), vtnp_(maxres6), vtnp_a(maxres6)
- common /cipiszcze/ itt
- itt=itime
- if (ntwe.ne.0) then
- if (large.and. mod(itime,ntwe).eq.0) then
- write (iout,*) "***************** RESPA itime",itime
- write (iout,*) "Cartesian and internal coordinates: step 0"
-c call cartprint
- call pdbout(0.0d0,"cipiszcze",iout)
- call intout
- write (iout,*) "Accelerations from long-range forces"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3),
- & (d_a(j,i+nres),j=1,3)
- enddo
- write (iout,*) "Velocities, step 0"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3),
- & (d_t(j,i+nres),j=1,3)
- enddo
- endif
- endif
-c
-c Perform the initial RESPA step (increment velocities)
-c write (iout,*) "*********************** RESPA ini"
- if (tnp1) then
- call tnp_respa_step1
- else if (tnp) then
- call tnp_respa_step1
- else
- if (tnh.and..not.xiresp) then
- call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8)
- do i=0,2*nres
- do j=1,3
- d_t(j,i)=d_t(j,i)*scale_nh
- enddo
- enddo
- endif
- call RESPA_vel
- endif
-
-cd if(tnp .or. tnp1) then
-cd write (iout,'(a,3f)') "EE1 NP S, pi",totT, s_np, pi_np
-cd endif
-
- if (ntwe.ne.0) then
- if (mod(itime,ntwe).eq.0 .and. large) then
- write (iout,*) "Velocities, end"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3),
- & (d_t(j,i+nres),j=1,3)
- enddo
- endif
- endif
-c Compute the short-range forces
-#ifdef MPI
- tt0 =MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
-C 7/2/2009 commented out
-c call zerograd
-c call etotal_short(energia_short)
- if (tnp.or.tnp1) potE=energia_short(0)
-c call cartgrad
-c call lagrangian
-C 7/2/2009 Copy accelerations due to short-lange forces from previous MD step
- do i=0,2*nres
- do j=1,3
- d_a(j,i)=d_a_short(j,i)
- enddo
- enddo
- if (ntwe.ne.0) then
- if (large.and. mod(itime,ntwe).eq.0) then
- write (iout,*) "energia_short",energia_short(0)
- write (iout,*) "Accelerations from short-range forces"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3),
- & (d_a(j,i+nres),j=1,3)
- enddo
- endif
- endif
-#ifdef MPI
- t_enegrad=t_enegrad+MPI_Wtime()-tt0
-#else
- t_enegrad=t_enegrad+tcpu()-tt0
-#endif
- do i=0,2*nres
- do j=1,3
- dc_old(j,i)=dc(j,i)
- if(.not.(tnp .or. tnp1)) d_t_old(j,i)=d_t(j,i)
- d_a_old(j,i)=d_a(j,i)
- enddo
- enddo
-c 6/30/08 A-MTS: attempt at increasing the split number
- do i=0,2*nres
- do j=1,3
- dc_old0(j,i)=dc_old(j,i)
- d_t_old0(j,i)=d_t_old(j,i)
- d_a_old0(j,i)=d_a_old(j,i)
- enddo
- enddo
- if (ntime_split.gt.ntime_split0) ntime_split=ntime_split/2
- if (ntime_split.lt.ntime_split0) ntime_split=ntime_split0
-c
- scale=.true.
- d_time0=d_time
- do while (scale)
-
- scale=.false.
-c write (iout,*) "itime",itime," ntime_split",ntime_split
-c Split the time step
- d_time=d_time0/ntime_split
-c Perform the short-range RESPA steps (velocity Verlet increments of
-c positions and velocities using short-range forces)
-c write (iout,*) "*********************** RESPA split"
- do itsplit=1,ntime_split
- if (lang.eq.1) then
- call sddir_precalc
- else if (lang.eq.2 .or. lang.eq.3) then
-#ifndef LANG0
- call stochastic_force(stochforcvec)
-#else
- write (iout,*)
- & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0"
-#ifdef MPI
- call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
-#endif
- stop
-#endif
- endif
-c First step of the velocity Verlet algorithm
- if (lang.eq.2) then
-#ifndef LANG0
- call sd_verlet1
-#endif
- else if (lang.eq.3) then
-#ifndef LANG0
- call sd_verlet1_ciccotti
-#endif
- else if (lang.eq.1) then
- call sddir_verlet1
- else if (tnp1) then
- call tnp1_respa_i_step1
- else if (tnp) then
- call tnp_respa_i_step1
- else
- if (tnh.and.xiresp) then
- call kinetic(EK)
- call nhcint(EK,scale_nh,wdtii,wdtii2,wdtii4,wdtii8)
- do i=0,2*nres
- do j=1,3
- d_t_old(j,i)=d_t_old(j,i)*scale_nh
- enddo
- enddo
-cd write(iout,*) "SSS1",itsplit,EK,scale_nh
- endif
- call verlet1
- endif
-c Build the chain from the newly calculated coordinates
- call chainbuild_cart
- if (rattle) call rattle1
- if (ntwe.ne.0) then
- if (large.and. mod(itime,ntwe).eq.0) then
- write (iout,*) "***** ITSPLIT",itsplit
- write (iout,*) "Cartesian and internal coordinates: step 1"
- call pdbout(0.0d0,"cipiszcze",iout)
-c call cartprint
- call intout
- write (iout,*) "Velocities, step 1"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3),
- & (d_t(j,i+nres),j=1,3)
- enddo
- endif
- endif
-#ifdef MPI
- tt0 = MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
-c Calculate energy and forces
- call zerograd
- call etotal_short(energia_short)
- E_old=potE
- potE=energia_short(0)
-#ifdef TIMING_ENE
-#ifdef MPI
- t_eshort=t_eshort+MPI_Wtime()-tt0
-#else
- t_eshort=t_eshort+tcpu()-tt0
-#endif
-#endif
- call cartgrad
-c Get the new accelerations
- call lagrangian
-C 7/2/2009 Copy accelerations due to short-lange forces to an auxiliary array
- do i=0,2*nres
- do j=1,3
- d_a_short(j,i)=d_a(j,i)
- enddo
- enddo
- if (ntwe.ne.0) then
- if (large.and. mod(itime,ntwe).eq.0) then
- write (iout,*)"energia_short",energia_short(0)
- write (iout,*) "Accelerations from short-range forces"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3),
- & (d_a(j,i+nres),j=1,3)
- enddo
- endif
- endif
-c 6/30/08 A-MTS
-c Determine maximum acceleration and scale down the timestep if needed
- call max_accel
- amax=amax/ntime_split**2
- call predict_edrift(epdrift)
- if (ntwe.gt.0 .and. large .and. mod(itime,ntwe).eq.0)
- & write (iout,*) "amax",amax," damax",damax,
- & " epdrift",epdrift," epdriftmax",epdriftmax
-c Exit loop and try with increased split number if the change of
-c acceleration is too big
- if (amax.gt.damax .or. epdrift.gt.edriftmax) then
- if (ntime_split.lt.maxtime_split) then
- scale=.true.
- ntime_split=ntime_split*2
- do i=0,2*nres
- do j=1,3
- dc_old(j,i)=dc_old0(j,i)
- d_t_old(j,i)=d_t_old0(j,i)
- d_a_old(j,i)=d_a_old0(j,i)
- enddo
- enddo
- write (iout,*) "acceleration/energy drift too large",amax,
- & epdrift," split increased to ",ntime_split," itime",itime,
- & " itsplit",itsplit
- exit
- else
- write (iout,*)
- & "Uh-hu. Bumpy landscape. Maximum splitting number",
- & maxtime_split,
- & " already reached!!! Trying to carry on!"
- endif
- endif
-#ifdef MPI
- t_enegrad=t_enegrad+MPI_Wtime()-tt0
-#else
- t_enegrad=t_enegrad+tcpu()-tt0
-#endif
-c Second step of the velocity Verlet algorithm
- if (lang.eq.2) then
-#ifndef LANG0
- call sd_verlet2
-#endif
- else if (lang.eq.3) then
-#ifndef LANG0
- call sd_verlet2_ciccotti
-#endif
- else if (lang.eq.1) then
- call sddir_verlet2
- else if (tnp1) then
- call tnp1_respa_i_step2
- else if (tnp) then
- call tnp_respa_i_step2
- else
- call verlet2
- if (tnh.and.xiresp) then
- call kinetic(EK)
- call nhcint(EK,scale_nh,wdtii,wdtii2,wdtii4,wdtii8)
- do i=0,2*nres
- do j=1,3
- d_t(j,i)=d_t(j,i)*scale_nh
- enddo
- enddo
-cd write(iout,*) "SSS2",itsplit,EK,scale_nh
- endif
- endif
- if (rattle) call rattle2
-c Backup the coordinates, velocities, and accelerations
- if (tnp .or. tnp1) then
- do i=0,2*nres
- do j=1,3
- d_t_old(j,i)=d_t(j,i)
- if (tnp) d_t(j,i)=d_t(j,i)/s_np
- if (tnp1) d_t(j,i)=d_t(j,i)/s_np
- enddo
- enddo
- endif
-
- do i=0,2*nres
- do j=1,3
- dc_old(j,i)=dc(j,i)
- if(.not.(tnp .or. tnp1)) d_t_old(j,i)=d_t(j,i)
- d_a_old(j,i)=d_a(j,i)
- enddo
- enddo
- enddo
-
- enddo ! while scale
-
-c Restore the time step
- d_time=d_time0
-c Compute long-range forces
-#ifdef MPI
- tt0 =MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
- call zerograd
- call etotal_long(energia_long)
- E_long=energia_long(0)
- potE=energia_short(0)+energia_long(0)
-#ifdef TIMING_ENE
-#ifdef MPI
- t_elong=t_elong+MPI_Wtime()-tt0
-#else
- t_elong=t_elong+tcpu()-tt0
-#endif
-#endif
- call cartgrad
- call lagrangian
-#ifdef MPI
- t_enegrad=t_enegrad+MPI_Wtime()-tt0
-#else
- t_enegrad=t_enegrad+tcpu()-tt0
-#endif
-c Compute accelerations from long-range forces
- if (ntwe.ne.0) then
- if (large.and. mod(itime,ntwe).eq.0) then
- write (iout,*) "energia_long",energia_long(0)
- write (iout,*) "Cartesian and internal coordinates: step 2"
-c call cartprint
- call pdbout(0.0d0,"cipiszcze",iout)
- call intout
- write (iout,*) "Accelerations from long-range forces"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3),
- & (d_a(j,i+nres),j=1,3)
- enddo
- write (iout,*) "Velocities, step 2"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3),
- & (d_t(j,i+nres),j=1,3)
- enddo
- endif
- endif
-c Compute the final RESPA step (increment velocities)
-c write (iout,*) "*********************** RESPA fin"
- if (tnp1) then
- call tnp_respa_step2
- else if (tnp) then
- call tnp_respa_step2
- else
- call RESPA_vel
- if (tnh.and..not.xiresp) then
- call kinetic(EK)
- call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8)
- do i=0,2*nres
- do j=1,3
- d_t(j,i)=d_t(j,i)*scale_nh
- enddo
- enddo
- endif
- endif
-
- if (tnp .or. tnp1) then
- do i=0,2*nres
- do j=1,3
- d_t(j,i)=d_t_old(j,i)/s_np
- enddo
- enddo
- endif
-
-c Compute the complete potential energy
- do i=0,n_ene
- potEcomp(i)=energia_short(i)+energia_long(i)
- enddo
- potE=potEcomp(0)-potEcomp(20)
-c potE=energia_short(0)+energia_long(0)
- totT=totT+d_time
-c Calculate the kinetic and the total energy and the kinetic temperature
- call kinetic(EK)
- totE=EK+potE
-c Couple the system to Berendsen bath if needed
- if (tbf .and. lang.eq.0) then
- call verlet_bath
- endif
- kinetic_T=2.0d0/(dimen3*Rb)*EK
-c Backup the coordinates, velocities, and accelerations
- if (ntwe.ne.0) then
- if (mod(itime,ntwe).eq.0 .and. large) then
- write (iout,*) "Velocities, end"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3),
- & (d_t(j,i+nres),j=1,3)
- enddo
- endif
-
- if (mod(itime,ntwe).eq.0) then
-
- if(tnp .or. tnp1) then
-#ifndef G77
- write (iout,'(a3,7f20.10)') "TTT",EK,s_np,potE,pi_np,Csplit,
- & E_long,energia_short(0)
-#else
- write (iout,'(a3,7f20.10)') "TTT",EK,s_np,potE,pi_np,Csplit,
- & E_long,energia_short(0)
-#endif
- HNose1=Hnose(EK,s_np,potE,pi_np,Q_np,t_bath,dimen3)
- H=(HNose1-H0)*s_np
-cd write (iout,'(a,10f)') "hhh",EK,s_np,potE,pi_np,H0
-cd & ,EK+potE+pi_np**2/(2*Q_np)+dimen3*0.001986d0*t_bath*log(s_np)
-cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0
- hhh=h
-cd write (iout,'(a,3f)') "EE2 NP S, pi",totT, s_np, pi_np
- endif
-
- if(tnh) then
- HNose1=Hnose_nh(EK,potE)
- H=HNose1-H0
-cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0
- hhh=h
- endif
-
-
- if (large) then
- itnp=0
- do j=1,3
- itnp=itnp+1
- vtnp(itnp)=d_t(j,0)
- enddo
- do i=nnt,nct-1
- do j=1,3
- itnp=itnp+1
- vtnp(itnp)=d_t(j,i)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- itnp=itnp+1
- vtnp(itnp)=d_t(j,inres)
- enddo
- endif
- enddo
-
-c Transform velocities from UNRES coordinate space to cartesian and Gvec
-c eigenvector space
-
- do i=1,dimen3
- vtnp_(i)=0.0d0
- vtnp_a(i)=0.0d0
- do j=1,dimen3
- vtnp_(i)=vtnp_(i)+Gvec(j,i)*vtnp(j)
- vtnp_a(i)=vtnp_a(i)+A(i,j)*vtnp(j)
- enddo
- vtnp_(i)=vtnp_(i)*dsqrt(geigen(i))
- enddo
-
- do i=1,dimen3
- write (iout,'("WWW",i3,3f10.5)') i,vtnp(i),vtnp_(i),vtnp_a(i)
- enddo
-
- endif
- endif
- endif
-
-
- return
- end
-c---------------------------------------------------------------------
- subroutine RESPA_vel
-c First and last RESPA step (incrementing velocities using long-range
-c forces).
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- do j=1,3
- d_t(j,0)=d_t(j,0)+0.5d0*d_a(j,0)*d_time
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=d_t(j,i)+0.5d0*d_a(j,i)*d_time
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time
- enddo
- endif
- enddo
- return
- end
-c-----------------------------------------------------------------
- subroutine verlet1
-c Applying velocity Verlet algorithm - step 1 to coordinates
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision adt,adt2
-
-#ifdef DEBUG
- write (iout,*) "VELVERLET1 START: DC"
- do i=0,nres
- write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3),
- & (dc(j,i+nres),j=1,3)
- enddo
-#endif
- do j=1,3
- adt=d_a_old(j,0)*d_time
- adt2=0.5d0*adt
- dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time
- d_t_new(j,0)=d_t_old(j,0)+adt2
- d_t(j,0)=d_t_old(j,0)+adt
- enddo
- do i=nnt,nct-1
- do j=1,3
- adt=d_a_old(j,i)*d_time
- adt2=0.5d0*adt
- dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time
- d_t_new(j,i)=d_t_old(j,i)+adt2
- d_t(j,i)=d_t_old(j,i)+adt
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- adt=d_a_old(j,inres)*d_time
- adt2=0.5d0*adt
- dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time
- d_t_new(j,inres)=d_t_old(j,inres)+adt2
- d_t(j,inres)=d_t_old(j,inres)+adt
- enddo
- endif
- enddo
-#ifdef DEBUG
- write (iout,*) "VELVERLET1 END: DC"
- do i=0,nres
- write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3),
- & (dc(j,i+nres),j=1,3)
- enddo
-#endif
- return
- end
-c---------------------------------------------------------------------
- subroutine verlet2
-c Step 2 of the velocity Verlet algorithm: update velocities
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- do j=1,3
- d_t(j,0)=d_t_new(j,0)+0.5d0*d_a(j,0)*d_time
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=d_t_new(j,i)+0.5d0*d_a(j,i)*d_time
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time
- enddo
- endif
- enddo
- return
- end
-c-----------------------------------------------------------------
- subroutine sddir_precalc
-c Applying velocity Verlet algorithm - step 1 to coordinates
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision stochforcvec(MAXRES6)
- common /stochcalc/ stochforcvec
-c
-c Compute friction and stochastic forces
-c
-#ifdef MPI
- time00=MPI_Wtime()
-#else
- time00=tcpu()
-#endif
- call friction_force
-#ifdef MPI
- time_fric=time_fric+MPI_Wtime()-time00
- time00=MPI_Wtime()
-#else
- time_fric=time_fric+tcpu()-time00
- time00=tcpu()
-#endif
- call stochastic_force(stochforcvec)
-#ifdef MPI
- time_stoch=time_stoch+MPI_Wtime()-time00
-#else
- time_stoch=time_stoch+tcpu()-time00
-#endif
-c
-c Compute the acceleration due to friction forces (d_af_work) and stochastic
-c forces (d_as_work)
-c
- call ginv_mult(fric_work, d_af_work)
- call ginv_mult(stochforcvec, d_as_work)
- return
- end
-c---------------------------------------------------------------------
- subroutine sddir_verlet1
-c Applying velocity Verlet algorithm - step 1 to velocities
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-c Revised 3/31/05 AL: correlation between random contributions to
-c position and velocity increments included.
- double precision sqrt13 /0.57735026918962576451d0/ ! 1/sqrt(3)
- double precision adt,adt2
-c
-c Add the contribution from BOTH friction and stochastic force to the
-c coordinates, but ONLY the contribution from the friction forces to velocities
-c
- do j=1,3
- adt=(d_a_old(j,0)+d_af_work(j))*d_time
- adt2=0.5d0*adt+sqrt13*d_as_work(j)*d_time
- dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time
- d_t_new(j,0)=d_t_old(j,0)+0.5d0*adt
- d_t(j,0)=d_t_old(j,0)+adt
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- adt=(d_a_old(j,i)+d_af_work(ind+j))*d_time
- adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time
- dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time
- d_t_new(j,i)=d_t_old(j,i)+0.5d0*adt
- d_t(j,i)=d_t_old(j,i)+adt
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time
- adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time
- dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time
- d_t_new(j,inres)=d_t_old(j,inres)+0.5d0*adt
- d_t(j,inres)=d_t_old(j,inres)+adt
- enddo
- ind=ind+3
- endif
- enddo
- return
- end
-c---------------------------------------------------------------------
- subroutine sddir_verlet2
-c Calculating the adjusted velocities for accelerations
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision stochforcvec(MAXRES6),d_as_work1(MAXRES6)
- double precision cos60 /0.5d0/, sin60 /0.86602540378443864676d0/
-c Revised 3/31/05 AL: correlation between random contributions to
-c position and velocity increments included.
-c The correlation coefficients are calculated at low-friction limit.
-c Also, friction forces are now not calculated with new velocities.
-
-c call friction_force
- call stochastic_force(stochforcvec)
-c
-c Compute the acceleration due to friction forces (d_af_work) and stochastic
-c forces (d_as_work)
-c
- call ginv_mult(stochforcvec, d_as_work1)
-
-c
-c Update velocities
-c
- do j=1,3
- d_t(j,0)=d_t_new(j,0)+(0.5d0*(d_a(j,0)+d_af_work(j))
- & +sin60*d_as_work(j)+cos60*d_as_work1(j))*d_time
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=d_t_new(j,i)+(0.5d0*(d_a(j,i)+d_af_work(ind+j))
- & +sin60*d_as_work(ind+j)+cos60*d_as_work1(ind+j))*d_time
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres)
- & +d_af_work(ind+j))+sin60*d_as_work(ind+j)
- & +cos60*d_as_work1(ind+j))*d_time
- enddo
- ind=ind+3
- endif
- enddo
- return
- end
-c---------------------------------------------------------------------
- subroutine max_accel
-c
-c Find the maximum difference in the accelerations of the the sites
-c at the beginning and the end of the time step.
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- double precision aux(3),accel(3),accel_old(3),dacc
- do j=1,3
-c aux(j)=d_a(j,0)-d_a_old(j,0)
- accel_old(j)=d_a_old(j,0)
- accel(j)=d_a(j,0)
- enddo
- amax=0.0d0
- do i=nnt,nct
-c Backbone
- if (i.lt.nct) then
-c 7/3/08 changed to asymmetric difference
- do j=1,3
-c accel(j)=aux(j)+0.5d0*(d_a(j,i)-d_a_old(j,i))
- accel_old(j)=accel_old(j)+0.5d0*d_a_old(j,i)
- accel(j)=accel(j)+0.5d0*d_a(j,i)
-c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j))
- if (dabs(accel(j)).gt.dabs(accel_old(j))) then
- dacc=dabs(accel(j)-accel_old(j))
- if (dacc.gt.amax) amax=dacc
- endif
- enddo
- endif
- enddo
-c Side chains
- do j=1,3
-c accel(j)=aux(j)
- accel_old(j)=d_a_old(j,0)
- accel(j)=d_a(j,0)
- enddo
- if (nnt.eq.2) then
- do j=1,3
- accel_old(j)=accel_old(j)+d_a_old(j,1)
- accel(j)=accel(j)+d_a(j,1)
- enddo
- endif
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
-c accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres)
- accel_old(j)=accel_old(j)+d_a_old(j,i+nres)
- accel(j)=accel(j)+d_a(j,i+nres)
- enddo
- endif
- do j=1,3
-c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j))
- if (dabs(accel(j)).gt.dabs(accel_old(j))) then
- dacc=dabs(accel(j)-accel_old(j))
- if (dacc.gt.amax) amax=dacc
- endif
- enddo
- do j=1,3
- accel_old(j)=accel_old(j)+d_a_old(j,i)
- accel(j)=accel(j)+d_a(j,i)
-c aux(j)=aux(j)+d_a(j,i)-d_a_old(j,i)
- enddo
- enddo
- return
- end
-c---------------------------------------------------------------------
- subroutine predict_edrift(epdrift)
-c
-c Predict the drift of the potential energy
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.MUCA'
- double precision epdrift,epdriftij
-c Drift of the potential energy
- epdrift=0.0d0
- do i=nnt,nct
-c Backbone
- if (i.lt.nct) then
- do j=1,3
- epdriftij=dabs((d_a(j,i)-d_a_old(j,i))*gcart(j,i))
- if (lmuca) epdriftij=epdriftij*factor
-c write (iout,*) "back",i,j,epdriftij
- if (epdriftij.gt.epdrift) epdrift=epdriftij
- enddo
- endif
-c Side chains
- if (itype(i).ne.10) then
- do j=1,3
- epdriftij=
- & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i))
- if (lmuca) epdriftij=epdriftij*factor
-c write (iout,*) "side",i,j,epdriftij
- if (epdriftij.gt.epdrift) epdrift=epdriftij
- enddo
- endif
- enddo
- epdrift=0.5d0*epdrift*d_time*d_time
-c write (iout,*) "epdrift",epdrift
- return
- end
-c-----------------------------------------------------------------------
- subroutine verlet_bath
-c
-c Coupling to the thermostat by using the Berendsen algorithm
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision T_half,fact
-c
- T_half=2.0d0/(dimen3*Rb)*EK
- fact=dsqrt(1.0d0+(d_time/tau_bath)*(t_bath/T_half-1.0d0))
-c write(iout,*) "T_half", T_half
-c write(iout,*) "EK", EK
-c write(iout,*) "fact", fact
- do j=1,3
- d_t(j,0)=fact*d_t(j,0)
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=fact*d_t(j,i)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=fact*d_t(j,inres)
- enddo
- endif
- enddo
- return
- end
-c---------------------------------------------------------
- subroutine init_MD
-c Set up the initial conditions of a MD simulation
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MP
- include 'mpif.h'
- character*16 form
- integer IERROR,ERRCODE
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.REMD'
- real*8 energia_long(0:n_ene),
- & energia_short(0:n_ene),vcm(3),incr(3),E_short
- double precision cm(3),L(3),xv,sigv,lowb,highb
- double precision varia(maxvar)
- character*256 qstr
- integer ilen
- external ilen
- character*50 tytul
- logical file_exist
- common /gucio/ cm
- d_time0=d_time
-c write(iout,*) "d_time", d_time
-c Compute the standard deviations of stochastic forces for Langevin dynamics
-c if the friction coefficients do not depend on surface area
- if (lang.gt.0 .and. .not.surfarea) then
- do i=nnt,nct-1
- stdforcp(i)=stdfp*dsqrt(gamp)
- enddo
- do i=nnt,nct
- stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i)))
- enddo
- endif
-c Open the pdb file for snapshotshots
-#ifdef MPI
- if(mdpdb) then
- if (ilen(tmpdir).gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"//
- & liczba(:ilen(liczba))//".pdb")
- open(ipdb,
- & file=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba))
- & //".pdb")
- else
-#ifdef NOXDR
- if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file))
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"//
- & liczba(:ilen(liczba))//".x")
- cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba))
- & //".x"
-#else
- if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file))
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"//
- & liczba(:ilen(liczba))//".cx")
- cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba))
- & //".cx"
-#endif
- endif
-#else
- if(mdpdb) then
- if (ilen(tmpdir).gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.pdb")
- open(ipdb,file=prefix(:ilen(prefix))//"_MD.pdb")
- else
- if (ilen(tmpdir).gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.cx")
- cartname=prefix(:ilen(prefix))//"_MD.cx"
- endif
-#endif
- if (usampl) then
- write (qstr,'(256(1h ))')
- ipos=1
- do i=1,nfrag
- iq = qinfrag(i,iset)*10
- iw = wfrag(i,iset)/100
- if (iw.gt.0) then
- if(me.eq.king.or..not.out1file)
- & write (iout,*) "Frag",qinfrag(i,iset),wfrag(i,iset),iq,iw
- write (qstr(ipos:ipos+6),'(2h_f,i1,1h_,i1,1h_,i1)') i,iq,iw
- ipos=ipos+7
- endif
- enddo
- do i=1,npair
- iq = qinpair(i,iset)*10
- iw = wpair(i,iset)/100
- if (iw.gt.0) then
- if(me.eq.king.or..not.out1file)
- & write (iout,*) "Pair",i,qinpair(i,iset),wpair(i,iset),iq,iw
- write (qstr(ipos:ipos+6),'(2h_p,i1,1h_,i1,1h_,i1)') i,iq,iw
- ipos=ipos+7
- endif
- enddo
-c pdbname=pdbname(:ilen(pdbname)-4)//qstr(:ipos-1)//'.pdb'
-#ifdef NOXDR
-c cartname=cartname(:ilen(cartname)-2)//qstr(:ipos-1)//'.x'
-#else
-c cartname=cartname(:ilen(cartname)-3)//qstr(:ipos-1)//'.cx'
-#endif
-c statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat'
- endif
- icg=1
- if (rest) then
- if (restart1file) then
- if (me.eq.king)
- & inquire(file=mremd_rst_name,exist=file_exist)
- write (*,*) me," Before broadcast: file_exist",file_exist
-#ifdef MPI
- call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM,
- & IERR)
- write (*,*) me," After broadcast: file_exist",file_exist
-#endif
-c inquire(file=mremd_rst_name,exist=file_exist)
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "Initial state read by master and distributed"
- else
- if (ilen(tmpdir).gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'
- & //liczba(:ilen(liczba))//'.rst')
- inquire(file=rest2name,exist=file_exist)
- endif
- if(file_exist) then
- if(.not.restart1file) then
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "Initial state will be read from file ",
- & rest2name(:ilen(rest2name))
- call readrst
- endif
- call rescale_weights(t_bath)
- else
- if(me.eq.king.or..not.out1file)then
- if (restart1file) then
- write(iout,*) "File ",mremd_rst_name(:ilen(mremd_rst_name)),
- & " does not exist"
- else
- write(iout,*) "File ",rest2name(:ilen(rest2name)),
- & " does not exist"
- endif
- write(iout,*) "Initial velocities randomly generated"
- endif
- call random_vel
- totT=0.0d0
- endif
- else
-c Generate initial velocities
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "Initial velocities randomly generated"
- call random_vel
- totT=0.0d0
- endif
-c rest2name = prefix(:ilen(prefix))//'.rst'
- if(me.eq.king.or..not.out1file)then
- write (iout,*) "Initial velocities"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3),
- & (d_t(j,i+nres),j=1,3)
- enddo
- call flush(iout)
-c Zeroing the total angular momentum of the system
- write(iout,*) "Calling the zero-angular
- & momentum subroutine"
- endif
- call inertia_tensor
-c Getting the potential energy and forces and velocities and accelerations
- call vcm_vel(vcm)
-c write (iout,*) "velocity of the center of the mass:"
-c write (iout,*) (vcm(j),j=1,3)
- do j=1,3
- d_t(j,0)=d_t(j,0)-vcm(j)
- enddo
-c Removing the velocity of the center of mass
- call vcm_vel(vcm)
- if(me.eq.king.or..not.out1file)then
- write (iout,*) "vcm right after adjustment:"
- write (iout,*) (vcm(j),j=1,3)
- call flush(iout)
- endif
- if (.not.rest) then
- call chainbuild
- if(iranconf.ne.0) then
- if (overlapsc) then
- print *, 'Calling OVERLAP_SC'
- call overlap_sc(fail)
- endif
-
- if (searchsc) then
- call sc_move(2,nres-1,10,1d10,nft_sc,etot)
- print *,'SC_move',nft_sc,etot
- if(me.eq.king.or..not.out1file)
- & write(iout,*) 'SC_move',nft_sc,etot
- endif
-
- if(dccart)then
- print *, 'Calling MINIM_DC'
- call minim_dc(etot,iretcode,nfun)
- else
- call geom_to_var(nvar,varia)
- print *,'Calling MINIMIZE.'
- call minimize(etot,varia,iretcode,nfun)
- call var_to_geom(nvar,varia)
- endif
- if(me.eq.king.or..not.out1file)
- & write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun
- endif
- endif
- call chainbuild_cart
- call kinetic(EK)
- if (tbf) then
- call verlet_bath
- endif
- kinetic_T=2.0d0/(dimen3*Rb)*EK
- if(me.eq.king.or..not.out1file)then
- call cartprint
- call intout
- endif
-#ifdef MPI
- tt0=MPI_Wtime()
-#else
- tt0=tcpu()
-#endif
- call zerograd
- call etotal(potEcomp)
-#ifdef TIMING_ENE
-#ifdef MPI
- t_etotal=t_etotal+MPI_Wtime()-tt0
-#else
- t_etotal=t_etotal+tcpu()-tt0
-#endif
-#endif
- potE=potEcomp(0)
-
- if(tnp .or. tnp1) then
- s_np=1.0
- pi_np=0.0
- HNose1=Hnose(EK,s_np,potE,pi_np,Q_np,t_bath,dimen3)
- H0=Hnose1
- write(iout,*) 'H0= ',H0
- endif
-
- if(tnh) then
- HNose1=Hnose_nh(EK,potE)
- H0=HNose1
- write (iout,*) 'H0= ',H0
- endif
-
- if (hmc.gt.0) then
- hmc_acc=0
- hmc_etot=potE+EK
- if(me.eq.king.or..not.out1file)
- & write(iout,*) 'HMC',hmc_etot,potE,EK
- do i=1,2*nres
- do j=1,3
- dc_hmc(j,i)=dc(j,i)
- enddo
- enddo
- endif
-
- call cartgrad
- call lagrangian
- call max_accel
- if (amax*d_time .gt. dvmax) then
- d_time=d_time*dvmax/amax
- if(me.eq.king.or..not.out1file) write (iout,*)
- & "Time step reduced to",d_time,
- & " because of too large initial acceleration."
- endif
- if(me.eq.king.or..not.out1file)then
- write(iout,*) "Potential energy and its components"
- call enerprint(potEcomp)
-c write(iout,*) (potEcomp(i),i=0,n_ene)
- endif
- potE=potEcomp(0)-potEcomp(20)
- totE=EK+potE
- itime=0
- if (ntwe.ne.0) call statout(itime)
- if(me.eq.king.or..not.out1file)
- & write (iout,'(/a/3(a25,1pe14.5/))') "Initial:",
- & " Kinetic energy",EK," potential energy",potE,
- & " total energy",totE," maximum acceleration ",
- & amax
- if (large) then
- write (iout,*) "Initial coordinates"
- do i=1,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(c(j,i),j=1,3),
- & (c(j,i+nres),j=1,3)
- enddo
- write (iout,*) "Initial dC"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3),
- & (dc(j,i+nres),j=1,3)
- enddo
- write (iout,*) "Initial velocities"
- write (iout,"(13x,' backbone ',23x,' side chain')")
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3),
- & (d_t(j,i+nres),j=1,3)
- enddo
- write (iout,*) "Initial accelerations"
- do i=0,nres
-c write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3),
- write (iout,'(i3,3f15.10,3x,3f15.10)') i,(d_a(j,i),j=1,3),
- & (d_a(j,i+nres),j=1,3)
- enddo
- endif
- do i=0,2*nres
- do j=1,3
- dc_old(j,i)=dc(j,i)
- d_t_old(j,i)=d_t(j,i)
- d_a_old(j,i)=d_a(j,i)
- enddo
-c write (iout,*) "dc_old",i,(dc_old(j,i),j=1,3)
- enddo
- if (RESPA) then
-#ifdef MPI
- tt0 =MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
- call zerograd
- call etotal_short(energia_short)
-#ifdef TIMING_ENE
-#ifdef MPI
- t_eshort=t_eshort+MPI_Wtime()-tt0
-#else
- t_eshort=t_eshort+tcpu()-tt0
-#endif
-#endif
-
- if(tnp .or. tnp1) then
- E_short=energia_short(0)
- HNose1=Hnose(EK,s_np,E_short,pi_np,Q_np,t_bath,dimen3)
- Csplit=Hnose1
-c Csplit =110
-c_new_var_csplit Csplit=H0-E_long
-c Csplit = H0-energia_short(0)
- write(iout,*) 'Csplit= ',Csplit
- endif
-
-
- call cartgrad
- call lagrangian
- if(.not.out1file .and. large) then
- write (iout,*) "energia_long",energia_long(0),
- & " energia_short",energia_short(0),
- & " total",energia_long(0)+energia_short(0)
- write (iout,*) "Initial fast-force accelerations"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3),
- & (d_a(j,i+nres),j=1,3)
- enddo
- endif
-C 7/2/2009 Copy accelerations due to short-lange forces to an auxiliary array
- do i=0,2*nres
- do j=1,3
- d_a_short(j,i)=d_a(j,i)
- enddo
- enddo
-#ifdef MPI
- tt0=MPI_Wtime()
-#else
- tt0=tcpu()
-#endif
- call zerograd
- call etotal_long(energia_long)
-#ifdef TIMING_ENE
-#ifdef MPI
- t_elong=t_elong+MPI_Wtime()-tt0
-#else
- t_elong=t_elong+tcpu()-tt0
-#endif
-#endif
- call cartgrad
- call lagrangian
- if(.not.out1file .and. large) then
- write (iout,*) "energia_long",energia_long(0)
- write (iout,*) "Initial slow-force accelerations"
- do i=0,nres
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3),
- & (d_a(j,i+nres),j=1,3)
- enddo
- endif
-#ifdef MPI
- t_enegrad=t_enegrad+MPI_Wtime()-tt0
-#else
- t_enegrad=t_enegrad+tcpu()-tt0
-#endif
- endif
-
-
-
- return
- end
-c-----------------------------------------------------------
- subroutine random_vel
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision xv,sigv,lowb,highb
-c Generate random velocities from Gaussian distribution of mean 0 and std of KT/m
-c First generate velocities in the eigenspace of the G matrix
-c write (iout,*) "Calling random_vel dimen dimen3",dimen,dimen3
-c call flush(iout)
-c write (iout,*) "RANDOM_VEL dimen",dimen
- xv=0.0d0
- ii=0
- do i=1,dimen
- do k=1,3
- ii=ii+1
- sigv=dsqrt((Rb*t_bath)/geigen(i))
- lowb=-5*sigv
- highb=5*sigv
- d_t_work_new(ii)=anorm_distr(xv,sigv,lowb,highb)
-c write (iout,*) "i",i," ii",ii," geigen",geigen(i),
-c & " d_t_work_new",d_t_work_new(ii)
- enddo
- enddo
- call flush(iout)
-c diagnostics
-c Ek1=0.0d0
-c ii=0
-c do i=1,dimen
-c do k=1,3
-c ii=ii+1
-c Ek1=Ek1+0.5d0*geigen(i)*d_t_work_new(ii)**2
-c enddo
-c enddo
-c write (iout,*) "Ek from eigenvectors",Ek1
-c end diagnostics
-c Transform velocities to UNRES coordinate space
- do k=0,2
- do i=1,dimen
- ind=(i-1)*3+k+1
- d_t_work(ind)=0.0d0
- do j=1,dimen
- d_t_work(ind)=d_t_work(ind)
- & +Gvec(i,j)*d_t_work_new((j-1)*3+k+1)
- enddo
-c write (iout,*) "i",i," ind",ind," d_t_work",d_t_work(ind)
-c call flush(iout)
- enddo
- enddo
-c Transfer to the d_t vector
- do j=1,3
- d_t(j,0)=d_t_work(j)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- ind=ind+1
- d_t(j,i)=d_t_work(ind)
- enddo
- enddo
-c do i=0,nres-1
-c write (iout,*) "d_t",i,(d_t(j,i),j=1,3)
-c enddo
-c call flush(iout)
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- ind=ind+1
- d_t(j,i+nres)=d_t_work(ind)
- enddo
- endif
- enddo
-c call kinetic(EK)
-c write (iout,*) "Kinetic energy",Ek,EK1," kinetic temperature",
-c & 2.0d0/(dimen3*Rb)*EK,2.0d0/(dimen3*Rb)*EK1
-c call flush(iout)
- return
- end
-#ifndef LANG0
-c-----------------------------------------------------------
- subroutine sd_verlet_p_setup
-c Sets up the parameters of stochastic Verlet algorithm
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision emgdt(MAXRES6),
- & pterm,vterm,rho,rhoc,vsig,
- & pfric_vec(MAXRES6),vfric_vec(MAXRES6),
- & afric_vec(MAXRES6),prand_vec(MAXRES6),
- & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6)
- logical lprn /.false./
- double precision zero /1.0d-8/, gdt_radius /0.05d0/
- double precision ktm
-#ifdef MPI
- tt0 = MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
-c
-c AL 8/17/04 Code adapted from tinker
-c
-c Get the frictional and random terms for stochastic dynamics in the
-c eigenspace of mass-scaled UNRES friction matrix
-c
- do i = 1, dimen
- gdt = fricgam(i) * d_time
-c
-c Stochastic dynamics reduces to simple MD for zero friction
-c
- if (gdt .le. zero) then
- pfric_vec(i) = 1.0d0
- vfric_vec(i) = d_time
- afric_vec(i) = 0.5d0 * d_time * d_time
- prand_vec(i) = 0.0d0
- vrand_vec1(i) = 0.0d0
- vrand_vec2(i) = 0.0d0
-c
-c Analytical expressions when friction coefficient is large
-c
- else
- if (gdt .ge. gdt_radius) then
- egdt = dexp(-gdt)
- pfric_vec(i) = egdt
- vfric_vec(i) = (1.0d0-egdt) / fricgam(i)
- afric_vec(i) = (d_time-vfric_vec(i)) / fricgam(i)
- pterm = 2.0d0*gdt - 3.0d0 + (4.0d0-egdt)*egdt
- vterm = 1.0d0 - egdt**2
- rho = (1.0d0-egdt)**2 / sqrt(pterm*vterm)
-c
-c Use series expansions when friction coefficient is small
-c
- else
- gdt2 = gdt * gdt
- gdt3 = gdt * gdt2
- gdt4 = gdt2 * gdt2
- gdt5 = gdt2 * gdt3
- gdt6 = gdt3 * gdt3
- gdt7 = gdt3 * gdt4
- gdt8 = gdt4 * gdt4
- gdt9 = gdt4 * gdt5
- afric_vec(i) = (gdt2/2.0d0 - gdt3/6.0d0 + gdt4/24.0d0
- & - gdt5/120.0d0 + gdt6/720.0d0
- & - gdt7/5040.0d0 + gdt8/40320.0d0
- & - gdt9/362880.0d0) / fricgam(i)**2
- vfric_vec(i) = d_time - fricgam(i)*afric_vec(i)
- pfric_vec(i) = 1.0d0 - fricgam(i)*vfric_vec(i)
- pterm = 2.0d0*gdt3/3.0d0 - gdt4/2.0d0
- & + 7.0d0*gdt5/30.0d0 - gdt6/12.0d0
- & + 31.0d0*gdt7/1260.0d0 - gdt8/160.0d0
- & + 127.0d0*gdt9/90720.0d0
- vterm = 2.0d0*gdt - 2.0d0*gdt2 + 4.0d0*gdt3/3.0d0
- & - 2.0d0*gdt4/3.0d0 + 4.0d0*gdt5/15.0d0
- & - 4.0d0*gdt6/45.0d0 + 8.0d0*gdt7/315.0d0
- & - 2.0d0*gdt8/315.0d0 + 4.0d0*gdt9/2835.0d0
- rho = sqrt(3.0d0) * (0.5d0 - 3.0d0*gdt/16.0d0
- & - 17.0d0*gdt2/1280.0d0
- & + 17.0d0*gdt3/6144.0d0
- & + 40967.0d0*gdt4/34406400.0d0
- & - 57203.0d0*gdt5/275251200.0d0
- & - 1429487.0d0*gdt6/13212057600.0d0)
- end if
-c
-c Compute the scaling factors of random terms for the nonzero friction case
-c
- ktm = 0.5d0*d_time/fricgam(i)
- psig = dsqrt(ktm*pterm) / fricgam(i)
- vsig = dsqrt(ktm*vterm)
- rhoc = dsqrt(1.0d0 - rho*rho)
- prand_vec(i) = psig
- vrand_vec1(i) = vsig * rho
- vrand_vec2(i) = vsig * rhoc
- end if
- end do
- if (lprn) then
- write (iout,*)
- & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,",
- & " vrand_vec2"
- do i=1,dimen
- write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i),
- & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i)
- enddo
- endif
-c
-c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables
-c
-#ifndef LANG0
- call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat)
- call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat)
- call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat)
- call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat)
- call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec1,vrand_mat1)
- call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2)
-#endif
-#ifdef MPI
- t_sdsetup=t_sdsetup+MPI_Wtime()
-#else
- t_sdsetup=t_sdsetup+tcpu()-tt0
-#endif
- return
- end
-c-------------------------------------------------------------
- subroutine eigtransf1(n,ndim,ab,d,c)
- implicit none
- integer n,ndim
- double precision ab(ndim,ndim,n),c(ndim,n),d(ndim)
- integer i,j,k
- do i=1,n
- do j=1,n
- c(i,j)=0.0d0
- do k=1,n
- c(i,j)=c(i,j)+ab(k,j,i)*d(k)
- enddo
- enddo
- enddo
- return
- end
-c-------------------------------------------------------------
- subroutine eigtransf(n,ndim,a,b,d,c)
- implicit none
- integer n,ndim
- double precision a(ndim,n),b(ndim,n),c(ndim,n),d(ndim)
- integer i,j,k
- do i=1,n
- do j=1,n
- c(i,j)=0.0d0
- do k=1,n
- c(i,j)=c(i,j)+a(i,k)*b(k,j)*d(k)
- enddo
- enddo
- enddo
- return
- end
-c-------------------------------------------------------------
- subroutine sd_verlet1
-c Applying stochastic velocity Verlet algorithm - step 1 to velocities
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision stochforcvec(MAXRES6)
- common /stochcalc/ stochforcvec
- logical lprn /.false./
-
-c write (iout,*) "dc_old"
-c do i=0,nres
-c write (iout,'(i5,3f10.5,5x,3f10.5)')
-c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3)
-c enddo
- do j=1,3
- dc_work(j)=dc_old(j,0)
- d_t_work(j)=d_t_old(j,0)
- d_a_work(j)=d_a_old(j,0)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- dc_work(ind+j)=dc_old(j,i)
- d_t_work(ind+j)=d_t_old(j,i)
- d_a_work(ind+j)=d_a_old(j,i)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- dc_work(ind+j)=dc_old(j,i+nres)
- d_t_work(ind+j)=d_t_old(j,i+nres)
- d_a_work(ind+j)=d_a_old(j,i+nres)
- enddo
- ind=ind+3
- endif
- enddo
-#ifndef LANG0
- if (lprn) then
- write (iout,*)
- & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,",
- & " vrand_mat2"
- do i=1,dimen
- do j=1,dimen
- write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j),
- & vfric_mat(i,j),afric_mat(i,j),
- & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j)
- enddo
- enddo
- endif
- do i=1,dimen
- ddt1=0.0d0
- ddt2=0.0d0
- do j=1,dimen
- dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j)
- & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j)
- ddt1=ddt1+pfric_mat(i,j)*d_t_work(j)
- ddt2=ddt2+vfric_mat(i,j)*d_a_work(j)
- enddo
- d_t_work_new(i)=ddt1+0.5d0*ddt2
- d_t_work(i)=ddt1+ddt2
- enddo
-#endif
- do j=1,3
- dc(j,0)=dc_work(j)
- d_t(j,0)=d_t_work(j)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- dc(j,i)=dc_work(ind+j)
- d_t(j,i)=d_t_work(ind+j)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- dc(j,inres)=dc_work(ind+j)
- d_t(j,inres)=d_t_work(ind+j)
- enddo
- ind=ind+3
- endif
- enddo
- return
- end
-c--------------------------------------------------------------------------
- subroutine sd_verlet2
-c Calculating the adjusted velocities for accelerations
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6)
- common /stochcalc/ stochforcvec
-c
-c Compute the stochastic forces which contribute to velocity change
-c
- call stochastic_force(stochforcvecV)
-
-#ifndef LANG0
- do i=1,dimen
- ddt1=0.0d0
- ddt2=0.0d0
- do j=1,dimen
- ddt1=ddt1+vfric_mat(i,j)*d_a_work(j)
- ddt2=ddt2+vrand_mat1(i,j)*stochforcvec(j)+
- & vrand_mat2(i,j)*stochforcvecV(j)
- enddo
- d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2
- enddo
-#endif
- do j=1,3
- d_t(j,0)=d_t_work(j)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=d_t_work(ind+j)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=d_t_work(ind+j)
- enddo
- ind=ind+3
- endif
- enddo
- return
- end
-c-----------------------------------------------------------
- subroutine sd_verlet_ciccotti_setup
-c Sets up the parameters of stochastic velocity Verlet algorithmi; Ciccotti's
-c version
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision emgdt(MAXRES6),
- & pterm,vterm,rho,rhoc,vsig,
- & pfric_vec(MAXRES6),vfric_vec(MAXRES6),
- & afric_vec(MAXRES6),prand_vec(MAXRES6),
- & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6)
- logical lprn /.false./
- double precision zero /1.0d-8/, gdt_radius /0.05d0/
- double precision ktm
-#ifdef MPI
- tt0 = MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
-c
-c AL 8/17/04 Code adapted from tinker
-c
-c Get the frictional and random terms for stochastic dynamics in the
-c eigenspace of mass-scaled UNRES friction matrix
-c
- do i = 1, dimen
- write (iout,*) "i",i," fricgam",fricgam(i)
- gdt = fricgam(i) * d_time
-c
-c Stochastic dynamics reduces to simple MD for zero friction
-c
- if (gdt .le. zero) then
- pfric_vec(i) = 1.0d0
- vfric_vec(i) = d_time
- afric_vec(i) = 0.5d0*d_time*d_time
- prand_vec(i) = afric_vec(i)
- vrand_vec2(i) = vfric_vec(i)
-c
-c Analytical expressions when friction coefficient is large
-c
- else
- egdt = dexp(-gdt)
- pfric_vec(i) = egdt
- vfric_vec(i) = dexp(-0.5d0*gdt)*d_time
- afric_vec(i) = 0.5d0*dexp(-0.25d0*gdt)*d_time*d_time
- prand_vec(i) = afric_vec(i)
- vrand_vec2(i) = vfric_vec(i)
-c
-c Compute the scaling factors of random terms for the nonzero friction case
-c
-c ktm = 0.5d0*d_time/fricgam(i)
-c psig = dsqrt(ktm*pterm) / fricgam(i)
-c vsig = dsqrt(ktm*vterm)
-c prand_vec(i) = psig*afric_vec(i)
-c vrand_vec2(i) = vsig*vfric_vec(i)
- end if
- end do
- if (lprn) then
- write (iout,*)
- & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,",
- & " vrand_vec2"
- do i=1,dimen
- write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i),
- & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i)
- enddo
- endif
-c
-c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables
-c
- call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat)
- call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat)
- call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat)
- call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat)
- call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2)
-#ifdef MPI
- t_sdsetup=t_sdsetup+MPI_Wtime()
-#else
- t_sdsetup=t_sdsetup+tcpu()-tt0
-#endif
- return
- end
-c-------------------------------------------------------------
- subroutine sd_verlet1_ciccotti
-c Applying stochastic velocity Verlet algorithm - step 1 to velocities
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision stochforcvec(MAXRES6)
- common /stochcalc/ stochforcvec
- logical lprn /.false./
-
-c write (iout,*) "dc_old"
-c do i=0,nres
-c write (iout,'(i5,3f10.5,5x,3f10.5)')
-c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3)
-c enddo
- do j=1,3
- dc_work(j)=dc_old(j,0)
- d_t_work(j)=d_t_old(j,0)
- d_a_work(j)=d_a_old(j,0)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- dc_work(ind+j)=dc_old(j,i)
- d_t_work(ind+j)=d_t_old(j,i)
- d_a_work(ind+j)=d_a_old(j,i)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- dc_work(ind+j)=dc_old(j,i+nres)
- d_t_work(ind+j)=d_t_old(j,i+nres)
- d_a_work(ind+j)=d_a_old(j,i+nres)
- enddo
- ind=ind+3
- endif
- enddo
-
-#ifndef LANG0
- if (lprn) then
- write (iout,*)
- & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,",
- & " vrand_mat2"
- do i=1,dimen
- do j=1,dimen
- write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j),
- & vfric_mat(i,j),afric_mat(i,j),
- & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j)
- enddo
- enddo
- endif
- do i=1,dimen
- ddt1=0.0d0
- ddt2=0.0d0
- do j=1,dimen
- dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j)
- & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j)
- ddt1=ddt1+pfric_mat(i,j)*d_t_work(j)
- ddt2=ddt2+vfric_mat(i,j)*d_a_work(j)
- enddo
- d_t_work_new(i)=ddt1+0.5d0*ddt2
- d_t_work(i)=ddt1+ddt2
- enddo
-#endif
- do j=1,3
- dc(j,0)=dc_work(j)
- d_t(j,0)=d_t_work(j)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- dc(j,i)=dc_work(ind+j)
- d_t(j,i)=d_t_work(ind+j)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- dc(j,inres)=dc_work(ind+j)
- d_t(j,inres)=d_t_work(ind+j)
- enddo
- ind=ind+3
- endif
- enddo
- return
- end
-c--------------------------------------------------------------------------
- subroutine sd_verlet2_ciccotti
-c Calculating the adjusted velocities for accelerations
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6)
- common /stochcalc/ stochforcvec
-c
-c Compute the stochastic forces which contribute to velocity change
-c
- call stochastic_force(stochforcvecV)
-#ifndef LANG0
- do i=1,dimen
- ddt1=0.0d0
- ddt2=0.0d0
- do j=1,dimen
-
- ddt1=ddt1+vfric_mat(i,j)*d_a_work(j)
-c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j)
- ddt2=ddt2+vrand_mat2(i,j)*stochforcvec(j)
- enddo
- d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2
- enddo
-#endif
- do j=1,3
- d_t(j,0)=d_t_work(j)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=d_t_work(ind+j)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=d_t_work(ind+j)
- enddo
- ind=ind+3
- endif
- enddo
- return
- end
-#endif
-c------------------------------------------------------
- double precision function HNose(ek,s,e,pi,Q,t_bath,dimenl)
- implicit none
- double precision ek,s,e,pi,Q,t_bath,Rb
- integer dimenl
- Rb=0.001986d0
- HNose=ek+e+pi**2/(2*Q)+dimenl*Rb*t_bath*log(s)
-c print '(6f15.5,i5,a2,2f15.5)',ek,s,e,pi,Q,t_bath,dimenl,"--",
-c & pi**2/(2*Q),dimenl*Rb*t_bath*log(s)
- return
- end
-c-----------------------------------------------------------------
- double precision function HNose_nh(eki,e)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MD'
- HNose_nh=eki+e+dimen3*Rb*t_bath*xlogs(1)+qmass(1)*vlogs(1)**2/2
- do i=2,nnos
- HNose_nh=HNose_nh+qmass(i)*vlogs(i)**2/2+Rb*t_bath*xlogs(i)
- enddo
-c write(4,'(5e15.5)')
-c & vlogs(1),xlogs(1),HNose,eki,e
- return
- end
-c-----------------------------------------------------------------
- SUBROUTINE NHCINT(akin,scale,wdti,wdti2,wdti4,wdti8)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MD'
- double precision akin,gnkt,dt,aa,gkt,scale
- double precision wdti(maxyosh),wdti2(maxyosh),
- & wdti4(maxyosh),wdti8(maxyosh)
- integer i,iresn,iyosh,inos,nnos1
-
- dt=d_time
- nnos1=nnos+1
- GKT = Rb*t_bath
- GNKT = dimen3*GKT
- akin=akin*2
-
-
-C THIS ROUTINE DOES THE NOSE-HOOVER PART OF THE
-C INTEGRATION FROM t=0 TO t=DT/2
-C GET THE TOTAL KINETIC ENERGY
- SCALE = 1.D0
-c CALL GETKINP(MASS,VX,VY,VZ,AKIN)
-C UPDATE THE FORCES
- GLOGS(1) = (AKIN - GNKT)/QMASS(1)
-C START THE MULTIPLE TIME STEP PROCEDURE
- DO IRESN = 1,NRESN
- DO IYOSH = 1,NYOSH
-C UPDATE THE THERMOSTAT VELOCITIES
- VLOGS(NNOS) = VLOGS(NNOS) + GLOGS(NNOS)*WDTI4(IYOSH)
- DO INOS = 1,NNOS-1
- AA = EXP(-WDTI8(IYOSH)*VLOGS(NNOS1-INOS) )
- VLOGS(NNOS-INOS) = VLOGS(NNOS-INOS)*AA*AA
- & + WDTI4(IYOSH)*GLOGS(NNOS-INOS)*AA
- ENDDO
-C UPDATE THE PARTICLE VELOCITIES
- AA = EXP(-WDTI2(IYOSH)*VLOGS(1) )
- SCALE = SCALE*AA
-C UPDATE THE FORCES
- GLOGS(1) = (SCALE*SCALE*AKIN - GNKT)/QMASS(1)
-C UPDATE THE THERMOSTAT POSITIONS
- DO INOS = 1,NNOS
- XLOGS(INOS) = XLOGS(INOS) + VLOGS(INOS)*WDTI2(IYOSH)
- ENDDO
-C UPDATE THE THERMOSTAT VELOCITIES
- DO INOS = 1,NNOS-1
- AA = EXP(-WDTI8(IYOSH)*VLOGS(INOS+1) )
- VLOGS(INOS) = VLOGS(INOS)*AA*AA
- & + WDTI4(IYOSH)*GLOGS(INOS)*AA
- GLOGS(INOS+1) = (QMASS(INOS)*VLOGS(INOS)*VLOGS(INOS)
- & -GKT)/QMASS(INOS+1)
- ENDDO
- VLOGS(NNOS) = VLOGS(NNOS) + GLOGS(NNOS)*WDTI4(IYOSH)
- ENDDO
- ENDDO
-C UPDATE THE PARTICLE VELOCITIES
-c outside of this subroutine
-c DO I = 1,N
-c VX(I) = VX(I)*SCALE
-c VY(I) = VY(I)*SCALE
-c VZ(I) = VZ(I)*SCALE
-c ENDDO
- RETURN
- END
-c-----------------------------------------------------------------
- subroutine tnp1_respa_i_step1
-c Applying Nose-Poincare algorithm - step 1 to coordinates
-c JPSJ 70 75 (2001) S. Nose
-c
-c d_t is not updated here
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision adt,adt2,tmp
-
- tmp=1+pi_np/(2*Q_np)*0.5*d_time
- s12_np=s_np*tmp**2
- pistar=pi_np/tmp
- s12_dt=d_time/s12_np
- d_time_s12=d_time*0.5*s12_np
-
- do j=1,3
- d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s12
- dc(j,0)=dc_old(j,0)+d_t_new(j,0)*s12_dt
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s12
- dc(j,i)=dc_old(j,i)+d_t_new(j,i)*s12_dt
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s12
- dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*s12_dt
- enddo
- endif
- enddo
- return
- end
-c---------------------------------------------------------------------
- subroutine tnp1_respa_i_step2
-c Step 2 of the velocity Verlet algorithm: update velocities
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-
- double precision d_time_s12
-
- do i=0,2*nres
- do j=1,3
- d_t(j,i)=d_t_new(j,i)
- enddo
- enddo
-
- call kinetic(EK)
- EK=EK/s12_np**2
-
- d_time_s12=0.5d0*s12_np*d_time
-
- do j=1,3
- d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s12
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s12
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s12
- enddo
- endif
- enddo
-
- pistar=pistar+(EK-0.5*(E_old+potE)
- & -dimen3*Rb*t_bath*log(s12_np)+Csplit-dimen3*Rb*t_bath)*d_time
- tmp=1+pistar/(2*Q_np)*0.5*d_time
- s_np=s12_np*tmp**2
- pi_np=pistar/tmp
-
- return
- end
-c-------------------------------------------------------
-
- subroutine tnp1_step1
-c Applying Nose-Poincare algorithm - step 1 to coordinates
-c JPSJ 70 75 (2001) S. Nose
-c
-c d_t is not updated here
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision adt,adt2,tmp
-
- tmp=1+pi_np/(2*Q_np)*0.5*d_time
- s12_np=s_np*tmp**2
- pistar=pi_np/tmp
- s12_dt=d_time/s12_np
- d_time_s12=d_time*0.5*s12_np
-
- do j=1,3
- d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s12
- dc(j,0)=dc_old(j,0)+d_t_new(j,0)*s12_dt
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s12
- dc(j,i)=dc_old(j,i)+d_t_new(j,i)*s12_dt
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s12
- dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*s12_dt
- enddo
- endif
- enddo
- return
- end
-c---------------------------------------------------------------------
- subroutine tnp1_step2
-c Step 2 of the velocity Verlet algorithm: update velocities
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-
- double precision d_time_s12
-
- do i=0,2*nres
- do j=1,3
- d_t(j,i)=d_t_new(j,i)
- enddo
- enddo
-
- call kinetic(EK)
- EK=EK/s12_np**2
-
- d_time_s12=0.5d0*s12_np*d_time
-
- do j=1,3
- d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s12
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s12
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s12
- enddo
- endif
- enddo
-
-cd write(iout,*) 'pistar',pistar,EK,E_old,potE,s12_np
- pistar=pistar+(EK-0.5*(E_old+potE)
- & -dimen3*Rb*t_bath*log(s12_np)+H0-dimen3*Rb*t_bath)*d_time
- tmp=1+pistar/(2*Q_np)*0.5*d_time
- s_np=s12_np*tmp**2
- pi_np=pistar/tmp
-
- return
- end
-
-c-----------------------------------------------------------------
- subroutine tnp_respa_i_step1
-c Applying Nose-Poincare algorithm - step 1 to coordinates
-c J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird
-c
-c d_t is not updated here, it is destroyed
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision C_np,d_time_s,tmp,d_time_ss
-
- d_time_s=d_time*0.5*s_np
-ct2 d_time_s=d_time*0.5*s12_np
-
- do j=1,3
- d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s
- enddo
- endif
- enddo
-
- do i=0,2*nres
- do j=1,3
- d_t(j,i)=d_t_new(j,i)
- enddo
- enddo
-
- call kinetic(EK)
- EK=EK/s_np**2
-
- C_np=0.5*d_time*(dimen3*Rb*t_bath*(1.0+log(s_np))-EK+potE-Csplit)
- & -pi_np
-
- pistar=-2.0*C_np/(1.0+sqrt(1.0-C_np*d_time/Q_np))
- tmp=0.5*d_time*pistar/Q_np
- s12_np=s_np*(1.0+tmp)/(1.0-tmp)
-
- d_time_ss=0.5*d_time*(1.0/s12_np+1.0/s_np)
-ct2 d_time_ss=d_time/s12_np
-c d_time_ss=0.5*d_time*(1.0/sold_np+1.0/s_np)
-
- do j=1,3
- dc(j,0)=dc_old(j,0)+d_t_new(j,0)*d_time_ss
- enddo
- do i=nnt,nct-1
- do j=1,3
- dc(j,i)=dc_old(j,i)+d_t_new(j,i)*d_time_ss
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*d_time_ss
- enddo
- endif
- enddo
-
- return
- end
-c---------------------------------------------------------------------
-
- subroutine tnp_respa_i_step2
-c Step 2 of the velocity Verlet algorithm: update velocities
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-
- double precision d_time_s
-
- EK=EK*(s_np/s12_np)**2
- HNose1=Hnose(EK,s12_np,potE,pistar,Q_np,t_bath,dimen3)
- pi_np=pistar+0.5*d_time*(2*EK-dimen3*Rb*t_bath
- & -HNose1+Csplit)
-
-cr print '(a,5f)','i_step2',EK,potE,HNose1,pi_np,E_long
- d_time_s=d_time*0.5*s12_np
-c d_time_s=d_time*0.5*s_np
-
- do j=1,3
- d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s
- enddo
- endif
- enddo
-
- s_np=s12_np
-
- return
- end
-c-----------------------------------------------------------------
- subroutine tnp_respa_step1
-c Applying Nose-Poincare algorithm - step 1 to vel for RESPA
-c J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird
-c
-c d_t is not updated here, it is destroyed
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision C_np,d_time_s,tmp,d_time_ss
- double precision energia(0:n_ene)
-
- d_time_s=d_time*0.5*s_np
-
- do j=1,3
- d_t_old(j,0)=d_t_old(j,0)+d_a(j,0)*d_time_s
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t_old(j,i)=d_t_old(j,i)+d_a(j,i)*d_time_s
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t_old(j,inres)=d_t_old(j,inres)+d_a(j,inres)*d_time_s
- enddo
- endif
- enddo
-
-
-c C_np=0.5*d_time*(dimen3*Rb*t_bath*(1.0+log(s_np))-EK+potE-H0)
-c & -pi_np
-c
-c pistar=-2.0*C_np/(1.0+sqrt(1.0-C_np*d_time/Q_np))
-c tmp=0.5*d_time*pistar/Q_np
-c s12_np=s_np*(1.0+tmp)/(1.0-tmp)
-c write(iout,*) 'tnp_respa_step1',s_np,s12_np,EK,potE,C_np,pistar,tmp
-
-ct1 pi_np=pistar
-c sold_np=s_np
-c s_np=s12_np
-
-c-------------------------------------
-c test of reviewer's comment
- pi_np=pi_np-0.5*d_time*(E_long+Csplit-H0)
-cr print '(a,3f)','1 pi_np,s_np',pi_np,s_np,E_long
-c-------------------------------------
-
- return
- end
-c---------------------------------------------------------------------
- subroutine tnp_respa_step2
-c Step 2 of the velocity Verlet algorithm: update velocities for RESPA
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-
- double precision d_time_s
-
-ct1 s12_np=s_np
-ct2 pistar=pi_np
-
-ct call kinetic(EK)
-ct HNose1=Hnose(EK,s12_np,potE,pistar,Q_np,t_bath,dimen3)
-ct pi_np=pistar+0.5*d_time*(2*EK-dimen3*Rb*t_bath)
-ct & -0.5*d_time*(HNose1-H0)
-
-c-------------------------------------
-c test of reviewer's comment
- pi_np=pi_np-0.5*d_time*(E_long+Csplit-H0)
-cr print '(a,3f)','2 pi_np,s_np',pi_np,s_np,E_long
-c-------------------------------------
- d_time_s=d_time*0.5*s_np
-
- do j=1,3
- d_t_old(j,0)=d_t_old(j,0)+d_a(j,0)*d_time_s
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t_old(j,i)=d_t_old(j,i)+d_a(j,i)*d_time_s
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t_old(j,inres)=d_t_old(j,inres)+d_a(j,inres)*d_time_s
- enddo
- endif
- enddo
-
-cd s_np=s12_np
-
- return
- end
-c---------------------------------------------------------------------
- subroutine tnp_step1
-c Applying Nose-Poincare algorithm - step 1 to coordinates
-c J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird
-c
-c d_t is not updated here, it is destroyed
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision C_np,d_time_s,tmp,d_time_ss
-
- d_time_s=d_time*0.5*s_np
-
- do j=1,3
- d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s
- enddo
- endif
- enddo
-
- do i=0,2*nres
- do j=1,3
- d_t(j,i)=d_t_new(j,i)
- enddo
- enddo
-
- call kinetic(EK)
- EK=EK/s_np**2
-
- C_np=0.5*d_time*(dimen3*Rb*t_bath*(1.0+log(s_np))-EK+potE-H0)
- & -pi_np
-
- pistar=-2.0*C_np/(1.0+sqrt(1.0-C_np*d_time/Q_np))
- tmp=0.5*d_time*pistar/Q_np
- s12_np=s_np*(1.0+tmp)/(1.0-tmp)
-c write(iout,*) 'tnp_step1',s_np,s12_np,EK,potE,C_np,pistar,tmp
-
- d_time_ss=0.5*d_time*(1.0/s12_np+1.0/s_np)
-
- do j=1,3
- dc(j,0)=dc_old(j,0)+d_t_new(j,0)*d_time_ss
- enddo
- do i=nnt,nct-1
- do j=1,3
- dc(j,i)=dc_old(j,i)+d_t_new(j,i)*d_time_ss
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*d_time_ss
- enddo
- endif
- enddo
-
- return
- end
-c-----------------------------------------------------------------
- subroutine tnp_step2
-c Step 2 of the velocity Verlet algorithm: update velocities
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-
- double precision d_time_s
-
- EK=EK*(s_np/s12_np)**2
- HNose1=Hnose(EK,s12_np,potE,pistar,Q_np,t_bath,dimen3)
- pi_np=pistar+0.5*d_time*(2*EK-dimen3*Rb*t_bath)
- & -0.5*d_time*(HNose1-H0)
-
-cd write(iout,'(a,4f)') 'mmm',EK,potE,HNose1,pi_np
- d_time_s=d_time*0.5*s12_np
-
- do j=1,3
- d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- inres=i+nres
- do j=1,3
- d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s
- enddo
- endif
- enddo
-
- s_np=s12_np
-
- return
- end
-
- subroutine hmc_test(itime)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
-
- hmc_acc=hmc_acc+1
- delta=-(potE+EK-hmc_etot)/(Rb*t_bath)
- if (delta .lt. -50.0d0) then
- delta=0.0d0
- else
- delta=dexp(delta)
- endif
- xxx=ran_number(0.0d0,1.0d0)
-
- if (me.eq.king .or. .not. out1file)
- & write(iout,'(a8,i5,6f10.4)')
- & 'HMC',itime,potE+EK,potE,EK,hmc_etot,delta,xxx
-
- if (delta .le. xxx) then
- do i=1,2*nres
- do j=1,3
- dc(j,i)=dc_hmc(j,i)
- enddo
- enddo
- itime=itime-hmc
- totT=totThmc
- else
- if (me.eq.king .or. .not. out1file)
- & write(iout,*) 'HMC accepting new'
- totThmc=totT
- do i=1,2*nres
- do j=1,3
- dc_hmc(j,i)=dc(j,i)
- enddo
- enddo
- endif
-
- call chainbuild_cart
- call random_vel
- do i=0,2*nres
- do j=1,3
- d_t_old(j,i)=d_t(j,i)
- enddo
- enddo
- call kinetic(EK)
- kinetic_T=2.0d0/(dimen3*Rb)*EK
- call etotal(potEcomp)
- potE=potEcomp(0)
- hmc_etot=potE+EK
- if (me.eq.king .or. .not. out1file)
- & write(iout,'(a8,i5,3f10.4)')'HMC new',itime,potE+EK,potE,EK
-
-
- return
- end
+++ /dev/null
-#ifdef MPI
- subroutine init_task
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- logical lprn /.false./
-c real*8 text1 /'group_i '/,text2/'group_f '/,
-c & text3/'initialb'/,text4/'initiale'/,
-c & text5/'openb'/,text6/'opene'/
- integer cgtasks(0:max_cg_procs)
- character*3 cfgprocs
- integer cg_size,fg_size,fg_size1
-c start parallel processing
-c print *,'Initializing MPI'
- call mpi_init(ierr)
- if (ierr.ne.0) then
- print *, ' cannot initialize MPI'
- stop
- endif
-c determine # of nodes and current node
- call MPI_Comm_rank( MPI_COMM_WORLD, me, ierr )
- if (ierr.ne.0) then
- print *, ' cannot determine rank of all processes'
- call MPI_Finalize( MPI_COMM_WORLD, IERR )
- stop
- endif
- call MPI_Comm_size( MPI_Comm_world, nodes, ierr )
- if (ierr.ne.0) then
- print *, ' cannot determine number of processes'
- stop
- endif
- Nprocs=nodes
- MyRank=me
-C Determine the number of "fine-grain" tasks
- call getenv_loc("FGPROCS",cfgprocs)
- read (cfgprocs,'(i3)') nfgtasks
- if (nfgtasks.eq.0) nfgtasks=1
- call getenv_loc("MAXGSPROCS",cfgprocs)
- read (cfgprocs,'(i3)') max_gs_size
- if (max_gs_size.eq.0) max_gs_size=2
- if (lprn)
- & print *,"Processor",me," nfgtasks",nfgtasks,
- & " max_gs_size",max_gs_size
- if (nfgtasks.eq.1) then
- CG_COMM = MPI_COMM_WORLD
- fg_size=1
- fg_rank=0
- nfgtasks1=1
- fg_rank1=0
- else
- nodes=nprocs/nfgtasks
- if (nfgtasks*nodes.ne.nprocs) then
- write (*,'(a)') 'ERROR: Number of processors assigned',
- & ' to coarse-grained tasks must be divisor',
- & ' of the total number of processors.'
- call MPI_Finalize( MPI_COMM_WORLD, IERR )
- stop
- endif
-C Put the ranks of coarse-grain processes in one table and create
-C the respective communicator. The processes with ranks "in between"
-C the ranks of CG processes will perform fine graining for the CG
-C process with the next lower rank.
- do i=0,nprocs-1,nfgtasks
- cgtasks(i/nfgtasks)=i
- enddo
- if (lprn) then
- print*,"Processor",me," cgtasks",(cgtasks(i),i=0,nodes-1)
-c print "(a,i5,a)","Processor",myrank," Before MPI_Comm_group"
- endif
-c call memmon_print_usage()
- call MPI_Comm_group(MPI_COMM_WORLD,world_group,IERR)
- call MPI_Group_incl(world_group,nodes,cgtasks,cg_group,IERR)
- call MPI_Comm_create(MPI_COMM_WORLD,cg_group,CG_COMM,IERR)
- call MPI_Group_rank(cg_group,me,ierr)
- call MPI_Group_free(world_group,ierr)
- call MPI_Group_free(cg_group,ierr)
-c print "(a,i5,a)","Processor",myrank," After MPI_Comm_group"
-c call memmon_print_usage()
- if (me.ne.MPI_UNDEFINED) call MPI_Comm_Rank(CG_COMM,me,ierr)
- if (lprn) print *," Processor",myrank," CG rank",me
-C Create communicators containig processes doing "fine grain" tasks.
-C The processes within each FG_COMM should have fast communication.
- kolor=MyRank/nfgtasks
- key=mod(MyRank,nfgtasks)
- call MPI_Comm_split(MPI_COMM_WORLD,kolor,key,FG_COMM,ierr)
- call MPI_Comm_size(FG_COMM,fg_size,ierr)
- if (fg_size.ne.nfgtasks) then
- write (*,*) "OOOOps... the number of fg tasks is",fg_size,
- & " but",nfgtasks," was requested. MyRank=",MyRank
- endif
- call MPI_Comm_rank(FG_COMM,fg_rank,ierr)
- if (fg_size.gt.max_gs_size) then
- kolor1=fg_rank/max_gs_size
- key1=mod(fg_rank,max_gs_size)
- call MPI_Comm_split(FG_COMM,kolor1,key1,FG_COMM1,ierr)
- call MPI_Comm_size(FG_COMM1,nfgtasks1,ierr)
- call MPI_Comm_rank(FG_COMM1,fg_rank1,ierr)
- else
- FG_COMM1=FG_COMM
- nfgtasks1=nfgtasks
- fg_rank1=fg_rank
- endif
- endif
- if (fg_rank.eq.0) then
- write (*,*) "Processor",MyRank," out of",nprocs,
- & " rank in CG_COMM",me," size of CG_COMM",nodes,
- & " size of FG_COMM",fg_size,
- & " rank in FG_COMM1",fg_rank1," size of FG_COMM1",nfgtasks1
- else
- write (*,*) "Processor",MyRank," out of",nprocs,
- & " rank in FG_COMM",fg_rank," size of FG_COMM",fg_size,
- & " rank in FG_COMM1",fg_rank1," size of FG_COMM1",nfgtasks1
- endif
-C Initialize other variables.
-c print '(a)','Before initialize'
-c call memmon_print_usage()
- call initialize
-c print '(a,i5,a)','Processor',myrank,' After initialize'
-c call memmon_print_usage()
-C Open task-dependent files.
-c print '(a,i5,a)','Processor',myrank,' Before openunits'
-c call memmon_print_usage()
- call openunits
-c print '(a,i5,a)','Processor',myrank,' After openunits'
-c call memmon_print_usage()
- if (me.eq.king .or. fg_rank.eq.0 .and. .not. out1file)
- & write (iout,'(80(1h*)/a/80(1h*))')
- & 'United-residue force field calculation - parallel job.'
-c print *,"Processor",myrank," exited OPENUNITS"
- return
- end
-C-----------------------------------------------------------------------------
- subroutine finish_task
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.REMD'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- include 'COMMON.MD'
- integer ilen
- external ilen
-c
- call MPI_Barrier(CG_COMM,ierr)
- if (nfgtasks.gt.1)
- & call MPI_Bcast(-1,1,MPI_INTEGER,king,FG_COMM,IERROR)
- time1=MPI_WTIME()
- if (me.eq.king .or. .not. out1file) then
- write (iout,'(a,i4,a)') 'CG processor',me,' is finishing work.'
- write (iout,*) 'Total wall clock time',time1-walltime,' sec'
- if (nfgtasks.gt.1) then
- write (iout,'(80(1h=)/a/(80(1h=)))')
- & "Details of FG communication time"
- write (iout,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))')
- & "BROADCAST:",time_bcast,"REDUCE:",time_reduce,
- & "GATHER:",time_gather,
- & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv,
- & "BARRIER ene",time_barrier_e,
- & "BARRIER grad",time_barrier_g,"TOTAL:",
- & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv
- & +time_barrier_e+time_barrier_g
- write (*,*) 'Total wall clock time',time1-walltime,' sec'
- write (*,*) "Processor",me," BROADCAST time",time_bcast,
- & " REDUCE time",
- & time_reduce," GATHER time",time_gather," SCATTER time",
- & time_scatter," SENDRECV",time_sendrecv,
- & " BARRIER ene",time_barrier_e," BARRIER grad",time_barrier_g
- endif
- endif
- write (*,'(a,i4,a)') 'CG processor',me,' is finishing work.'
- if (ilen(tmpdir).gt.0) then
- write (*,*) "Processor",me,
- & ": moving output files to the parent directory..."
- close(inp)
- close(istat,status='keep')
- if (ntwe.gt.0) call move_from_tmp(statname)
- close(irest2,status='keep')
- if (modecalc.eq.12.or.
- & (modecalc.eq.14 .and. .not.restart1file)) then
- call move_from_tmp(rest2name)
- else if (modecalc.eq.14.and. me.eq.king) then
- call move_from_tmp(mremd_rst_name)
- endif
- if (mdpdb) then
- close(ipdb,status='keep')
- call move_from_tmp(pdbname)
- else if (me.eq.king .or. .not.traj1file) then
- close(icart,status='keep')
- call move_from_tmp(cartname)
- endif
- if (me.eq.king .or. .not. out1file) then
- close (iout,status='keep')
- call move_from_tmp(outname)
- endif
- endif
- return
- end
-c-------------------------------------------------------------------------
- subroutine pattern_receive
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- include 'COMMON.THREAD'
- include 'COMMON.IOUNITS'
- integer tag,status(MPI_STATUS_SIZE)
- integer source,ThreadType
- logical flag
- ThreadType=45
- source=mpi_any_source
- call mpi_iprobe(source,ThreadType,
- & CG_COMM,flag,status,ierr)
- do while (flag)
- write (iout,*) 'Processor ',Me,' is receiving threading',
- & ' pattern from processor',status(mpi_source)
- write (*,*) 'Processor ',Me,' is receiving threading',
- & ' pattern from processor',status(mpi_source)
- nexcl=nexcl+1
- call mpi_irecv(iexam(1,nexcl),2,mpi_integer,status(mpi_source),
- & ThreadType, CG_COMM,ireq,ierr)
- write (iout,*) 'Received pattern:',nexcl,iexam(1,nexcl),
- & iexam(2,nexcl)
- source=mpi_any_source
- call mpi_iprobe(source,ThreadType,
- & CG_COMM,flag,status,ierr)
- enddo
- return
- end
-c----------------------------------------------------------------------------
- subroutine pattern_send
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.INFO'
- include 'COMMON.THREAD'
- include 'COMMON.IOUNITS'
- integer source,ThreadType,ireq
- ThreadType=45
- do iproc=0,nprocs-1
- if (iproc.ne.me .and. .not.Koniec(iproc) ) then
- call mpi_isend(iexam(1,nexcl),2,mpi_integer,iproc,
- & ThreadType, CG_COMM, ireq, ierr)
- write (iout,*) 'CG processor ',me,' has sent pattern ',
- & 'to processor',iproc
- write (*,*) 'CG processor ',me,' has sent pattern ',
- & 'to processor',iproc
- write (iout,*) 'Pattern:',nexcl,iexam(1,nexcl),iexam(2,nexcl)
- endif
- enddo
- return
- end
-c-----------------------------------------------------------------------------
- subroutine send_stop_sig(Kwita)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.INFO'
- include 'COMMON.IOUNITS'
- integer StopType,StopId,iproc,Kwita,NBytes
- StopType=66
-c Kwita=-1
-C print *,'CG processor',me,' StopType=',StopType
- Koniec(me)=.true.
- if (me.eq.king) then
-C Master sends the STOP signal to everybody.
- write (iout,'(a,a)')
- & 'Master is sending STOP signal to other processors.'
- do iproc=1,nprocs-1
- print *,'Koniec(',iproc,')=',Koniec(iproc)
- if (.not. Koniec(iproc)) then
- call mpi_send(Kwita,1,mpi_integer,iproc,StopType,
- & mpi_comm_world,ierr)
- write (iout,*) 'Iproc=',iproc,' StopID=',StopID
- write (*,*) 'Iproc=',iproc,' StopID=',StopID
- endif
- enddo
- else
-C Else send the STOP signal to Master.
- call mpi_send(Kwita,1,mpi_integer,MasterID,StopType,
- & mpi_comm_world,ierr)
- write (iout,*) 'CG processor=',me,' StopID=',StopID
- write (*,*) 'CG processor=',me,' StopID=',StopID
- endif
- return
- end
-c-----------------------------------------------------------------------------
- subroutine recv_stop_sig(Kwita)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.INFO'
- include 'COMMON.IOUNITS'
- integer source,StopType,StopId,iproc,Kwita
- logical flag
- StopType=66
- Kwita=0
- source=mpi_any_source
-c print *,'CG processor:',me,' StopType=',StopType
- call mpi_iprobe(source,StopType,
- & mpi_comm_world,flag,status,ierr)
- do while (flag)
- Koniec(status(mpi_source))=.true.
- write (iout,*) 'CG processor ',me,' is receiving STOP signal',
- & ' from processor',status(mpi_source)
- write (*,*) 'CG processor ',me,' is receiving STOP signal',
- & ' from processor',status(mpi_source)
- call mpi_irecv(Kwita,1,mpi_integer,status(mpi_source),StopType,
- & mpi_comm_world,ireq,ierr)
- call mpi_iprobe(source,StopType,
- & mpi_comm_world,flag,status,ierr)
- enddo
- return
- end
-c-----------------------------------------------------------------------------
- subroutine send_MCM_info(ione)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- include 'COMMON.MCM'
- include 'COMMON.IOUNITS'
- integer tag,status(MPI_STATUS_SIZE)
- integer MCM_info_Type,MCM_info_ID,iproc,one,NBytes
- common /aaaa/ isend,irecv
- integer nsend
- save nsend
- nsend=nsend+1
- MCM_info_Type=77
-cd write (iout,'(a,i4,a)') 'CG Processor',me,
-cd & ' is sending MCM info to Master.'
- write (*,'(a,i4,a,i8)') 'CG processor',me,
- & ' is sending MCM info to Master, MCM_info_ID=',MCM_info_ID
- call mpi_isend(ione,1,mpi_integer,MasterID,
- & MCM_info_Type,mpi_comm_world, MCM_info_ID, ierr)
-cd write (iout,*) 'CG processor',me,' has sent info to the master;',
-cd & ' MCM_info_ID=',MCM_info_ID
- write (*,*) 'CG processor',me,' has sent info to the master;',
- & ' MCM_info_ID=',MCM_info_ID,' ierr ',ierr
- isend=0
- irecv=0
- return
- end
-c----------------------------------------------------------------------------
- subroutine receive_MCM_info
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- include 'COMMON.MCM'
- include 'COMMON.IOUNITS'
- integer tag,status(MPI_STATUS_SIZE)
- integer source,MCM_info_Type,MCM_info_ID,iproc,ione
- logical flag
- MCM_info_Type=77
- source=mpi_any_source
-c print *,'source=',source,' dontcare=',dontcare
- call mpi_iprobe(source,MCM_info_Type,
- & mpi_comm_world,flag,status,ierr)
- do while (flag)
- source=status(mpi_source)
- itask=source/fgProcs+1
-cd write (iout,*) 'Master is receiving MCM info from processor ',
-cd & source,' itask',itask
- write (*,*) 'Master is receiving MCM info from processor ',
- & source,' itask',itask
- call mpi_irecv(ione,1,mpi_integer,source,MCM_info_type,
- & mpi_comm_world,MCM_info_ID,ierr)
-cd write (iout,*) 'Received from processor',source,' IONE=',ione
- write (*,*) 'Received from processor',source,' IONE=',ione
- nacc_tot=nacc_tot+1
- if (ione.eq.2) nsave_part(itask)=nsave_part(itask)+1
-cd print *,'nsave_part(',itask,')=',nsave_part(itask)
-cd write (iout,*) 'Nacc_tot=',Nacc_tot
-cd write (*,*) 'Nacc_tot=',Nacc_tot
- source=mpi_any_source
- call mpi_iprobe(source,MCM_info_Type,
- & mpi_comm_world,flag,status,ierr)
- enddo
- return
- end
-c---------------------------------------------------------------------------
- subroutine send_thread_results
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- include 'COMMON.THREAD'
- include 'COMMON.IOUNITS'
- integer tag,status(MPI_STATUS_SIZE)
- integer ibuffer(2*maxthread+2),ThreadType,ThreadID,EnerType,
- & EnerID,msglen,nbytes
- double precision buffer(20*maxthread+2)
- ThreadType=444
- EnerType=555
- ipatt(1,nthread+1)=nthread
- ipatt(2,nthread+1)=nexcl
- do i=1,nthread
- do j=1,n_ene
- ener(j,i+nthread)=ener0(j,i)
- enddo
- enddo
- ener(1,2*nthread+1)=max_time_for_thread
- ener(2,2*nthread+1)=ave_time_for_thread
-C Send the IPATT array
- write (iout,*) 'CG processor',me,
- & ' is sending IPATT array to master: NTHREAD=',nthread
- write (*,*) 'CG processor',me,
- & ' is sending IPATT array to master: NTHREAD=',nthread
- msglen=2*nthread+2
- call mpi_send(ipatt(1,1),msglen,MPI_INTEGER,MasterID,
- & ThreadType,mpi_comm_world,ierror)
- write (iout,*) 'CG processor',me,
- & ' has sent IPATT array to master MSGLEN',msglen
- write (*,*) 'CG processor',me,
- & ' has sent IPATT array to master MSGLEN',msglen
-C Send the energies.
- msglen=n_ene2*nthread+2
- write (iout,*) 'CG processor',me,' is sending energies to master.'
- write (*,*) 'CG processor',me,' is sending energies to master.'
- call mpi_send(ener(1,1),msglen,MPI_DOUBLE_PRECISION,MasterID,
- & EnerType,mpi_comm_world,ierror)
- write (iout,*) 'CG processor',me,' has sent energies to master.'
- write (*,*) 'CG processor',me,' has sent energies to master.'
- return
- end
-c----------------------------------------------------------------------------
- subroutine receive_thread_results(iproc)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.INFO'
- include 'COMMON.THREAD'
- include 'COMMON.IOUNITS'
- integer ibuffer(2*maxthread+2),ThreadType,ThreadID,EnerType,
- & EnerID,ReadyType,ReadyID,Ready,msglen,nbytes,nthread_temp
- double precision buffer(20*maxthread+2),max_time_for_thread_t,
- & ave_time_for_thread_t
- logical flag
- ThreadType=444
- EnerType=555
-C Receive the IPATT array
- call mpi_probe(iproc,ThreadType,
- & mpi_comm_world,status,ierr)
- call MPI_GET_COUNT(STATUS, MPI_INTEGER, MSGLEN, IERROR)
- write (iout,*) 'Master is receiving IPATT array from processor:',
- & iproc,' MSGLEN',msglen
- write (*,*) 'Master is receiving IPATT array from processor:',
- & iproc,' MSGLEN',msglen
- call mpi_recv(ipatt(1,nthread+1),msglen,mpi_integer,iproc,
- & ThreadType,
- & mpi_comm_world,status,ierror)
- write (iout,*) 'Master has received IPATT array from processor:',
- & iproc,' MSGLEN=',msglen
- write (*,*) 'Master has received IPATT array from processor:',
- & iproc,' MSGLEN=',msglen
- nthread_temp=ipatt(1,nthread+msglen/2)
- nexcl_temp=ipatt(2,nthread+msglen/2)
-C Receive the energies.
- call mpi_probe(iproc,EnerType,
- & mpi_comm_world,status,ierr)
- call MPI_GET_COUNT(STATUS, MPI_DOUBLE_PRECISION, MSGLEN, IERROR)
- write (iout,*) 'Master is receiving energies from processor:',
- & iproc,' MSGLEN=',MSGLEN
- write (*,*) 'Master is receiving energies from processor:',
- & iproc,' MSGLEN=',MSGLEN
- call mpi_recv(ener(1,nthread+1),msglen,
- & MPI_DOUBLE_PRECISION,iproc,
- & EnerType,MPI_COMM_WORLD,status,ierror)
- write (iout,*) 'Msglen=',Msglen
- write (*,*) 'Msglen=',Msglen
- write (iout,*) 'Master has received energies from processor',iproc
- write (*,*) 'Master has received energies from processor',iproc
- write (iout,*) 'NTHREAD_TEMP=',nthread_temp,' NEXCL=',nexcl_temp
- write (*,*) 'NTHREAD_TEMP=',nthread_temp,' NEXCL=',nexcl_temp
- do i=1,nthread_temp
- do j=1,n_ene
- ener0(j,nthread+i)=ener(j,nthread+nthread_temp+i)
- enddo
- enddo
- max_time_for_thread_t=ener(1,nthread+2*nthread_temp+1)
- ave_time_for_thread_t=ener(2,nthread+2*nthread_temp+1)
- write (iout,*) 'MAX_TIME_FOR_THREAD:',max_time_for_thread_t
- write (iout,*) 'AVE_TIME_FOR_THREAD:',ave_time_for_thread_t
- write (*,*) 'MAX_TIME_FOR_THREAD:',max_time_for_thread_t
- write (*,*) 'AVE_TIME_FOR_THREAD:',ave_time_for_thread_t
- if (max_time_for_thread_t.gt.max_time_for_thread)
- & max_time_for_thread=max_time_for_thread_t
- ave_time_for_thread=(nthread*ave_time_for_thread+
- & nthread_temp*ave_time_for_thread_t)/(nthread+nthread_temp)
- nthread=nthread+nthread_temp
- return
- end
-#else
- subroutine init_task
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.SETUP'
- me=0
- myrank=0
- fg_rank=0
- fg_size=1
- nodes=1
- nprocs=1
- call initialize
- call openunits
- write (iout,'(80(1h*)/a/80(1h*))')
- & 'United-residue force field calculation - serial job.'
- return
- end
-#endif
+++ /dev/null
-#ifdef MPI
- subroutine MREMD
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.MUCA'
- integer ERRCODE
- double precision cm(3),L(3),vcm(3)
- double precision energia(0:n_ene)
- double precision remd_t_bath(maxprocs)
- integer iremd_iset(maxprocs)
- integer*2 i_index
- & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
- double precision remd_ene(0:n_ene+4,maxprocs),t_bath_old
- integer iremd_acc(maxprocs),iremd_tot(maxprocs)
- integer iremd_acc_usa(maxprocs),iremd_tot_usa(maxprocs)
- integer ilen,rstcount
- external ilen
- character*50 tytul
- common /gucio/ cm
- integer itime
-cold integer nup(0:maxprocs),ndown(0:maxprocs)
- integer rep2i(0:maxprocs),ireqi(maxprocs)
- integer icache_all(maxprocs)
- integer status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs)
- logical synflag,end_of_run,file_exist /.false./,ovrtim
- real ene_tol /1.0e-5/
-
-cdeb imin_itime_old=0
- ntwx_cache=0
- time00=MPI_WTIME()
- time01=time00
- if(me.eq.king.or..not.out1file) then
- write (iout,*) 'MREMD',nodes,'time before',time00-walltime
- write (iout,*) "NREP=",nrep
- endif
-
- synflag=.false.
- if (ilen(tmpdir).gt.0 .and. (me.eq.king)) then
- call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_mremd.rst")
- endif
- mremd_rst_name=prefix(:ilen(prefix))//"_mremd.rst"
-
-cd print *,'MREMD',nodes
-cd print *,'mmm',me,remd_mlist,(remd_m(i),i=1,nrep)
-cde write (iout,*) "Start MREMD: me",me," t_bath",t_bath
-
- if(hremd.gt.0) then
- nset=hremd
- do i=1,nset
- mset(i)=1
- enddo
- endif
-
- k=0
- rep2i(k)=-1
- do il=1,max0(nset,1)
- do il1=1,max0(mset(il),1)
- do i=1,nrep
- iremd_acc(i)=0
- iremd_acc_usa(i)=0
- iremd_tot(i)=0
- do j=1,remd_m(i)
- i2rep(k)=i
- i2set(k)=il
- rep2i(i)=k
- k=k+1
- i_index(i,j,il,il1)=k
- enddo
- enddo
- enddo
- enddo
-
- if(me.eq.king.or..not.out1file) then
- write(iout,*) "i2rep",(i2rep(i),i=0,nodes-1)
- write(iout,*) "i2set",(i2set(i),i=0,nodes-1)
- write(iout,*) "i,j,il,il1,i_index(i,j,il,il1)"
- do il=1,nset
- do il1=1,mset(il)
- do i=1,nrep
- do j=1,remd_m(i)
- write(iout,*) i,j,il,il1,i_index(i,j,il,il1)
- enddo
- enddo
- enddo
- enddo
- endif
-
-c print *,'i2rep',me,i2rep(me)
-c print *,'rep2i',(rep2i(i),i=0,nrep)
-
-cold if (i2rep(me).eq.nrep) then
-cold nup(0)=0
-cold else
-cold nup(0)=remd_m(i2rep(me)+1)
-cold k=rep2i(int(i2rep(me)))+1
-cold do i=1,nup(0)
-cold nup(i)=k
-cold k=k+1
-cold enddo
-cold endif
-
-cd print '(i4,a4,100i4)',me,' nup',(nup(i),i=0,nup(0))
-
-cold if (i2rep(me).eq.1) then
-cold ndown(0)=0
-cold else
-cold ndown(0)=remd_m(i2rep(me)-1)
-cold k=rep2i(i2rep(me)-2)+1
-cold do i=1,ndown(0)
-cold ndown(i)=k
-cold k=k+1
-cold enddo
-cold endif
-
-cd print '(i4,a6,100i4)',me,' ndown',(ndown(i),i=0,ndown(0))
-
-
- write (*,*) "Processor",me," rest",rest,"
- & restart1fie",restart1file
- if(rest.and.restart1file) then
- if (me.eq.king)
- & inquire(file=mremd_rst_name,exist=file_exist)
-cd write (*,*) me," Before broadcast: file_exist",file_exist
- call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM,
- & IERR)
-cd write (*,*) me," After broadcast: file_exist",file_exist
- if(file_exist) then
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'Master is reading restart1file'
- call read1restart(i_index)
- else
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'WARNING : no restart1file'
- endif
-
- if(me.eq.king.or..not.out1file) then
- write(iout,*) "i2set",(i2set(i),i=0,nodes-1)
- write(iout,*) "i_index"
- do il=1,nset
- do il1=1,mset(il)
- do i=1,nrep
- do j=1,remd_m(i)
- write(iout,*) i,j,il,il1,i_index(i,j,il,il1)
- enddo
- enddo
- enddo
- enddo
- endif
- endif
-
- if(me.eq.king) then
- if (rest.and..not.restart1file)
- & inquire(file=mremd_rst_name,exist=file_exist)
- if(.not.file_exist.and.rest.and..not.restart1file)
- & write(iout,*) 'WARNING : no restart file',mremd_rst_name
- IF (rest.and.file_exist.and..not.restart1file) THEN
- write (iout,*) 'Master is reading restart file',
- & mremd_rst_name
- open(irest2,file=mremd_rst_name,status='unknown')
- read (irest2,*)
- read (irest2,*) (i2rep(i),i=0,nodes-1)
- read (irest2,*)
- read (irest2,*) (ifirst(i),i=1,remd_m(1))
- do il=1,nodes
- read (irest2,*)
- read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il))
- read (irest2,*)
- read (irest2,*) ndowna(0,il),
- & (ndowna(i,il),i=1,ndowna(0,il))
- enddo
- if(usampl.or.hremd.gt.0) then
- read (irest2,*)
- read (irest2,*) nset
- read (irest2,*)
- read (irest2,*) (mset(i),i=1,nset)
- read (irest2,*)
- read (irest2,*) (i2set(i),i=0,nodes-1)
- read (irest2,*)
- do il=1,nset
- do il1=1,mset(il)
- do i=1,nrep
- read(irest2,*) (i_index(i,j,il,il1),j=1,remd_m(i))
- enddo
- enddo
- enddo
-
- write(iout,*) "i2set",(i2set(i),i=0,nodes-1)
- write(iout,*) "i_index"
- do il=1,nset
- do il1=1,mset(il)
- do i=1,nrep
- do j=1,remd_m(i)
- write(iout,*) i,j,il,il1,i_index(i,j,il,il1)
- enddo
- enddo
- enddo
- enddo
- endif
-
- close(irest2)
-
- write (iout,'(a6,1000i5)') "i2rep",(i2rep(i),i=0,nodes-1)
- write (iout,'(a6,1000i5)') "ifirst",
- & (ifirst(i),i=1,remd_m(1))
- do il=1,nodes
- write (iout,'(a6,i4,a1,100i4)') "nupa",il,":",
- & (nupa(i,il),i=1,nupa(0,il))
- write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":",
- & (ndowna(i,il),i=1,ndowna(0,il))
- enddo
- ELSE IF (.not.(rest.and.file_exist)) THEN
- do il=1,remd_m(1)
- ifirst(il)=il
- enddo
-
- do il=1,nodes
- if (i2rep(il-1).eq.nrep) then
- nupa(0,il)=0
- else
- nupa(0,il)=remd_m(i2rep(il-1)+1)
- k=rep2i(int(i2rep(il-1)))+1
- do i=1,nupa(0,il)
- nupa(i,il)=k+1
- k=k+1
- enddo
- endif
- if (i2rep(il-1).eq.1) then
- ndowna(0,il)=0
- else
- ndowna(0,il)=remd_m(i2rep(il-1)-1)
- k=rep2i(i2rep(il-1)-2)+1
- do i=1,ndowna(0,il)
- ndowna(i,il)=k+1
- k=k+1
- enddo
- endif
- enddo
-
- write (iout,'(a6,100i4)') "ifirst",
- & (ifirst(i),i=1,remd_m(1))
- do il=1,nodes
- write (iout,'(a6,i4,a1,100i4)') "nupa",il,":",
- & (nupa(i,il),i=1,nupa(0,il))
- write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":",
- & (ndowna(i,il),i=1,ndowna(0,il))
- enddo
-
- ENDIF
- endif
-c
-c t_bath=retmin+(retmax-retmin)*me/(nodes-1)
- if(.not.(rest.and.file_exist.and.restart1file)) then
- if (me .eq. king) then
- t_bath=retmin
- else
- t_bath=retmin+(retmax-retmin)*exp(float(i2rep(me)-nrep))
- endif
-cd print *,'ttt',me,remd_tlist,(remd_t(i),i=1,nrep)
- if (remd_tlist) t_bath=remd_t(int(i2rep(me)))
-
- endif
- if(usampl.or.hremd.gt.0) then
- iset=i2set(me)
- if (hremd.gt.0) call set_hweights(iset)
- if(me.eq.king.or..not.out1file)
- & write(iout,*) me,"iset=",iset,"t_bath=",t_bath
- endif
-c
- stdfp=dsqrt(2*Rb*t_bath/d_time)
- do i=1,ntyp
- stdfsc(i)=dsqrt(2*Rb*t_bath/d_time)
- enddo
-
-c print *,'irep',me,t_bath
- if (.not.rest) then
- if (me.eq.king .or. .not. out1file)
- & write (iout,'(a60,f10.5)') "REMD Temperature:",t_bath
- call rescale_weights(t_bath)
- endif
-
-
-c------copy MD--------------
-c The driver for molecular dynamics subroutines
-c------------------------------------------------
- t_MDsetup=0.0d0
- t_langsetup=0.0d0
- t_MD=0.0d0
- t_enegrad=0.0d0
- t_sdsetup=0.0d0
- if(me.eq.king.or..not.out1file)
- & write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started"
-#ifdef MPI
- tt0 = MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
-c Determine the inverse of the inertia matrix.
- call setup_MD_matrices
-c Initialize MD
- call init_MD
- if (rest) then
- if (me.eq.king .or. .not. out1file)
- & write (iout,'(a60,f10.5)') "REMD restart Temperature:",t_bath
- stdfp=dsqrt(2*Rb*t_bath/d_time)
- do i=1,ntyp
- stdfsc(i)=dsqrt(2*Rb*t_bath/d_time)
- enddo
- if (lang.gt.0 .and. .not.surfarea) then
- do i=nnt,nct-1
- stdforcp(i)=stdfp*dsqrt(gamp)
- enddo
- do i=nnt,nct
- stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i)))
- enddo
- elseif (lang.gt.0 .and. surfarea ) then
- call setup_fricmat
- endif
- call rescale_weights(t_bath)
- endif
-
-#ifdef MPI
- t_MDsetup = MPI_Wtime()-tt0
-#else
- t_MDsetup = tcpu()-tt0
-#endif
- rstcount=0
-c Entering the MD loop
-#ifdef MPI
- tt0 = MPI_Wtime()
-#else
- tt0 = tcpu()
-#endif
- if (lang.eq.2 .or. lang.eq.3) then
-#ifndef LANG0
- call setup_fricmat
- if (lang.eq.2) then
- call sd_verlet_p_setup
- else
- call sd_verlet_ciccotti_setup
- endif
- do i=1,dimen
- do j=1,dimen
- pfric0_mat(i,j,0)=pfric_mat(i,j)
- afric0_mat(i,j,0)=afric_mat(i,j)
- vfric0_mat(i,j,0)=vfric_mat(i,j)
- prand0_mat(i,j,0)=prand_mat(i,j)
- vrand0_mat1(i,j,0)=vrand_mat1(i,j)
- vrand0_mat2(i,j,0)=vrand_mat2(i,j)
- enddo
- enddo
- flag_stoch(0)=.true.
- do i=1,maxflag_stoch
- flag_stoch(i)=.false.
- enddo
-#else
- write (iout,*)
- & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0"
-#ifdef MPI
- call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
-#endif
- stop
-#endif
- else if (lang.eq.1 .or. lang.eq.4) then
- call setup_fricmat
- endif
- time00=MPI_WTIME()
- if (me.eq.king .or. .not. out1file)
- & write(iout,*) 'Setup time',time00-walltime
-ctime call flush(iout)
-#ifdef MPI
- t_langsetup=MPI_Wtime()-tt0
- tt0=MPI_Wtime()
-#else
- t_langsetup=tcpu()-tt0
- tt0=tcpu()
-#endif
- itime=0
- end_of_run=.false.
- do while(.not.end_of_run)
- itime=itime+1
- if(itime.eq.n_timestep.and.me.eq.king) end_of_run=.true.
- if(mremdsync.and.itime.eq.n_timestep) end_of_run=.true.
- rstcount=rstcount+1
- if (lang.gt.0 .and. surfarea .and.
- & mod(itime,reset_fricmat).eq.0) then
- if (lang.eq.2 .or. lang.eq.3) then
-#ifndef LANG0
- call setup_fricmat
- if (lang.eq.2) then
- call sd_verlet_p_setup
- else
- call sd_verlet_ciccotti_setup
- endif
- do i=1,dimen
- do j=1,dimen
- pfric0_mat(i,j,0)=pfric_mat(i,j)
- afric0_mat(i,j,0)=afric_mat(i,j)
- vfric0_mat(i,j,0)=vfric_mat(i,j)
- prand0_mat(i,j,0)=prand_mat(i,j)
- vrand0_mat1(i,j,0)=vrand_mat1(i,j)
- vrand0_mat2(i,j,0)=vrand_mat2(i,j)
- enddo
- enddo
- flag_stoch(0)=.true.
- do i=1,maxflag_stoch
- flag_stoch(i)=.false.
- enddo
-#endif
- else if (lang.eq.1 .or. lang.eq.4) then
- call setup_fricmat
- endif
- write (iout,'(a,i10)')
- & "Friction matrix reset based on surface area, itime",itime
- endif
- if (reset_vel .and. tbf .and. lang.eq.0
- & .and. mod(itime,count_reset_vel).eq.0) then
- call random_vel
- if (me.eq.king .or. .not. out1file)
- & write(iout,'(a,f20.2)')
- & "Velocities reset to random values, time",totT
- do i=0,2*nres
- do j=1,3
- d_t_old(j,i)=d_t(j,i)
- enddo
- enddo
- endif
- if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then
- call inertia_tensor
- call vcm_vel(vcm)
- do j=1,3
- d_t(j,0)=d_t(j,0)-vcm(j)
- enddo
- call kinetic(EK)
- kinetic_T=2.0d0/(dimen3*Rb)*EK
- scalfac=dsqrt(T_bath/kinetic_T)
-cd write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT
- do i=0,2*nres
- do j=1,3
- d_t_old(j,i)=scalfac*d_t(j,i)
- enddo
- enddo
- endif
- if (lang.ne.4) then
- if (RESPA) then
-c Time-reversible RESPA algorithm
-c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992)
- call RESPA_step(itime)
- else
-c Variable time step algorithm.
- call velverlet_step(itime)
- endif
- else
-#ifdef BROWN
- call brown_step(itime)
-#else
- print *,"Brown dynamics not here!"
-#ifdef MPI
- call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
-#endif
- stop
-#endif
- endif
- if(hmc.gt.0 .and. mod(itime,hmc).eq.0) then
- call statout(itime)
- call hmc_test(itime)
- endif
- if(ntwe.ne.0) then
- if (mod(itime,ntwe).eq.0) call statout(itime)
- endif
- if (mod(itime,ntwx).eq.0.and..not.traj1file) then
- write (tytul,'("time",f8.2," temp",f8.1)') totT,t_bath
- if(mdpdb) then
- call pdbout(potE,tytul,ipdb)
- else
- call cartout(totT)
- endif
- endif
- if (mod(itime,ntwx).eq.0.and.traj1file) then
- if(ntwx_cache.lt.max_cache_traj_use) then
- ntwx_cache=ntwx_cache+1
- else
- if (max_cache_traj_use.ne.1)
- & print *,itime,"processor ",me," over cache ",ntwx_cache
- do i=1,ntwx_cache-1
-
- totT_cache(i)=totT_cache(i+1)
- EK_cache(i)=EK_cache(i+1)
- potE_cache(i)=potE_cache(i+1)
- t_bath_cache(i)=t_bath_cache(i+1)
- Uconst_cache(i)=Uconst_cache(i+1)
- iset_cache(i)=iset_cache(i+1)
-
- do ii=1,nfrag
- qfrag_cache(ii,i)=qfrag_cache(ii,i+1)
- enddo
- do ii=1,npair
- qpair_cache(ii,i)=qpair_cache(ii,i+1)
- enddo
- do ii=1,nfrag_back
- utheta_cache(ii,i)=utheta_cache(ii,i+1)
- ugamma_cache(ii,i)=ugamma_cache(ii,i+1)
- uscdiff_cache(ii,i)=uscdiff_cache(ii,i+1)
- enddo
-
-
- do ii=1,nres*2
- do j=1,3
- c_cache(j,ii,i)=c_cache(j,ii,i+1)
- enddo
- enddo
- enddo
- endif
-
- totT_cache(ntwx_cache)=totT
- EK_cache(ntwx_cache)=EK
- potE_cache(ntwx_cache)=potE
- t_bath_cache(ntwx_cache)=t_bath
- Uconst_cache(ntwx_cache)=Uconst
- iset_cache(ntwx_cache)=iset
-
- do i=1,nfrag
- qfrag_cache(i,ntwx_cache)=qfrag(i)
- enddo
- do i=1,npair
- qpair_cache(i,ntwx_cache)=qpair(i)
- enddo
- do i=1,nfrag_back
- utheta_cache(i,ntwx_cache)=utheta(i)
- ugamma_cache(i,ntwx_cache)=ugamma(i)
- uscdiff_cache(i,ntwx_cache)=uscdiff(i)
- enddo
-
- do i=1,nres*2
- do j=1,3
- c_cache(j,i,ntwx_cache)=c(j,i)
- enddo
- enddo
-
- endif
- if ((rstcount.eq.1000.or.itime.eq.n_timestep)
- & .and..not.restart1file) then
-
- if(me.eq.king) then
- open(irest1,file=mremd_rst_name,status='unknown')
- write (irest1,*) "i2rep"
- write (irest1,*) (i2rep(i),i=0,nodes-1)
- write (irest1,*) "ifirst"
- write (irest1,*) (ifirst(i),i=1,remd_m(1))
- do il=1,nodes
- write (irest1,*) "nupa",il
- write (irest1,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il))
- write (irest1,*) "ndowna",il
- write (irest1,*) ndowna(0,il),
- & (ndowna(i,il),i=1,ndowna(0,il))
- enddo
- if(usampl.or.hremd.gt.0) then
- write (irest1,*) "nset"
- write (irest1,*) nset
- write (irest1,*) "mset"
- write (irest1,*) (mset(i),i=1,nset)
- write (irest1,*) "i2set"
- write (irest1,*) (i2set(i),i=0,nodes-1)
- write (irest1,*) "i_index"
- do il=1,nset
- do il1=1,mset(il)
- do i=1,nrep
- write(irest1,*) (i_index(i,j,il,il1),j=1,remd_m(i))
- enddo
- enddo
- enddo
-
- endif
- close(irest1)
- endif
- open(irest2,file=rest2name,status='unknown')
- write(irest2,*) totT,EK,potE,totE,t_bath
- do i=1,2*nres
- write (irest2,'(3e15.5)') (d_t(j,i),j=1,3)
- enddo
- do i=1,2*nres
- write (irest2,'(3e15.5)') (dc(j,i),j=1,3)
- enddo
- if(usampl.or.hremd.gt.0) then
- write (irest2,*) iset
- endif
- close(irest2)
- rstcount=0
- endif
-
-c REMD - exchange
-c forced synchronization
- if (mod(itime,i_sync_step).eq.0 .and. me.ne.king
- & .and. .not. mremdsync) then
- synflag=.false.
- call mpi_iprobe(0,101,CG_COMM,synflag,status,ierr)
- if (synflag) then
- call mpi_recv(itime_master, 1, MPI_INTEGER,
- & 0,101,CG_COMM, status, ierr)
- call mpi_barrier(CG_COMM, ierr)
-cdeb if (out1file.or.traj1file) then
-cdeb call mpi_gather(itime,1,mpi_integer,
-cdeb & icache_all,1,mpi_integer,king,
-cdeb & CG_COMM,ierr)
- if(traj1file)
- & call mpi_gather(ntwx_cache,1,mpi_integer,
- & icache_all,1,mpi_integer,king,
- & CG_COMM,ierr)
- if (.not.out1file)
- & write(iout,*) 'REMD synchro at',itime_master,itime
- if (itime_master.ge.n_timestep .or. ovrtim())
- & end_of_run=.true.
-ctime call flush(iout)
- endif
- endif
-
-c REMD - exchange
- if ((mod(itime,nstex).eq.0.and.me.eq.king
- & .or.end_of_run.and.me.eq.king )
- & .and. .not. mremdsync ) then
- synflag=.true.
- time01_=MPI_WTIME()
- do i=1,nodes-1
- call mpi_isend(itime,1,MPI_INTEGER,i,101,
- & CG_COMM, ireqi(i), ierr)
-cd write(iout,*) 'REMD synchro with',i
-cd call flush(iout)
- enddo
- call mpi_waitall(nodes-1,ireqi,statusi,ierr)
- call mpi_barrier(CG_COMM, ierr)
- time01=MPI_WTIME()
- write(iout,*) 'REMD synchro at',itime,'time=',time01-time01_
- if (out1file.or.traj1file) then
-cdeb call mpi_gather(itime,1,mpi_integer,
-cdeb & itime_all,1,mpi_integer,king,
-cdeb & CG_COMM,ierr)
-cdeb write(iout,'(a19,8000i8)') ' REMD synchro itime',
-cdeb & (itime_all(i),i=1,nodes)
- if(traj1file) then
-cdeb imin_itime=itime_all(1)
-cdeb do i=2,nodes
-cdeb if(itime_all(i).lt.imin_itime) imin_itime=itime_all(i)
-cdeb enddo
-cdeb ii_write=(imin_itime-imin_itime_old)/ntwx
-cdeb imin_itime_old=int(imin_itime/ntwx)*ntwx
-cdeb write(iout,*) imin_itime,imin_itime_old,ii_write
- call mpi_gather(ntwx_cache,1,mpi_integer,
- & icache_all,1,mpi_integer,king,
- & CG_COMM,ierr)
-c write(iout,'(a19,8000i8)') ' ntwx_cache',
-c & (icache_all(i),i=1,nodes)
- ii_write=icache_all(1)
- do i=2,nodes
- if(icache_all(i).lt.ii_write) ii_write=icache_all(i)
- enddo
-c write(iout,*) "MIN ii_write=",ii_write
- endif
- endif
-ctime call flush(iout)
- endif
- if(mremdsync .and. mod(itime,nstex).eq.0) then
- synflag=.true.
- if (me.eq.king .or. .not. out1file)
- & write(iout,*) 'REMD synchro at',itime
-
- if(traj1file) then
- call mpi_gather(ntwx_cache,1,mpi_integer,
- & icache_all,1,mpi_integer,king,
- & CG_COMM,ierr)
- if (me.eq.king) then
- write(iout,'(a19,8000i8)') ' ntwx_cache',
- & (icache_all(i),i=1,nodes)
- ii_write=icache_all(1)
- do i=2,nodes
- if(icache_all(i).lt.ii_write) ii_write=icache_all(i)
- enddo
- write(iout,*) "MIN ii_write=",ii_write
- endif
- endif
-ctest call flush(iout)
- endif
- if (synflag) then
-c Update the time safety limiy
- if (time001-time00.gt.safety) then
- safety=time001-time00+600
- if (me.eq.king .or. .not. out1file)
- & write (iout,*) "****** SAFETY increased to",safety," s"
- endif
- if (ovrtim()) end_of_run=.true.
- endif
- if(synflag.and..not.end_of_run) then
- time02=MPI_WTIME()
- synflag=.false.
-
-c write(iout,*) 'REMD before',me,t_bath
-
-c call mpi_gather(t_bath,1,mpi_double_precision,
-c & remd_t_bath,1,mpi_double_precision,king,
-c & CG_COMM,ierr)
- potEcomp(n_ene+1)=t_bath
- t_bath_old=t_bath
- if (usampl) then
- potEcomp(n_ene+2)=iset
- if (iset.lt.nset) then
- i_set_temp=iset
- iset=iset+1
- call EconstrQ
- potEcomp(n_ene+3)=Uconst
- iset=i_set_temp
- endif
- if (iset.gt.1) then
- i_set_temp=iset
- iset=iset-1
- call EconstrQ
- potEcomp(n_ene+4)=Uconst
- iset=i_set_temp
- endif
- endif
- if(hremd.gt.0) potEcomp(n_ene+2)=iset
- call mpi_gather(potEcomp(0),n_ene+5,mpi_double_precision,
- & remd_ene(0,1),n_ene+5,mpi_double_precision,king,
- & CG_COMM,ierr)
- if(lmuca) then
- call mpi_gather(elow,1,mpi_double_precision,
- & elowi,1,mpi_double_precision,king,
- & CG_COMM,ierr)
- call mpi_gather(ehigh,1,mpi_double_precision,
- & ehighi,1,mpi_double_precision,king,
- & CG_COMM,ierr)
- endif
-
- time03=MPI_WTIME()
- if (me.eq.king .or. .not. out1file) then
- write(iout,*) 'REMD gather times=',time03-time01
- & ,time03-time02
- endif
-
- if (restart1file) call write1rst(i_index)
-
- time04=MPI_WTIME()
- if (me.eq.king .or. .not. out1file) then
- write(iout,*) 'REMD writing rst time=',time04-time03
- endif
-
- if (traj1file) call write1traj
-cd debugging
-cdeb call mpi_gather(ntwx_cache,1,mpi_integer,
-cdeb & icache_all,1,mpi_integer,king,
-cdeb & CG_COMM,ierr)
-cdeb write(iout,'(a19,8000i8)') ' ntwx_cache after traj1file',
-cdeb & (icache_all(i),i=1,nodes)
-cd end
-
-
- time05=MPI_WTIME()
- if (me.eq.king .or. .not. out1file) then
- write(iout,*) 'REMD writing traj time=',time05-time04
-ctime call flush(iout)
- endif
-
-
- if (me.eq.king) then
- do i=1,nodes
- remd_t_bath(i)=remd_ene(n_ene+1,i)
- iremd_iset(i)=remd_ene(n_ene+2,i)
- enddo
-#ifdef DEBUG
- if(lmuca) then
-co write(iout,*) 'REMD exchange temp,ene,elow,ehigh'
- do i=1,nodes
- write(iout,'(i4,4f12.5)') i,remd_t_bath(i),remd_ene(0,i),
- & elowi(i),ehighi(i)
- enddo
- else
- write(iout,*) 'REMD exchange temp,ene'
- do i=1,nodes
- write(iout,'(i4,2f12.5)') i,remd_t_bath(i),remd_ene(0,i)
- write(iout,'(6f12.5)') (remd_ene(j,i),j=1,n_ene)
- enddo
- endif
-#endif
-c-------------------------------------
- IF(.not.usampl.and.hremd.eq.0) THEN
-#ifdef DEBUG
- write (iout,*) "Enter exchnge, remd_m",remd_m(1),
- & " nodes",nodes
-ctime call flush(iout)
- write (iout,*) "remd_m(1)",remd_m(1)
-#endif
- do irr=1,remd_m(1)
- i=ifirst(iran_num(1,remd_m(1)))
-#ifdef DEBUG
- write (iout,*) "i",i
-#endif
-ctime call flush(iout)
-
- do ii=1,nodes-1
-
-#ifdef DEBUG
- write (iout,*) "i",i," nupa(0,i)",int(nupa(0,i))
-#endif
- if(i.gt.0.and.nupa(0,i).gt.0) then
- iex=i
-c if (i.eq.1 .and. int(nupa(0,i)).eq.1) then
-c write (iout,*)
-c & "CHUJ ABSOLUTNY!!! No way to sample a distinct replica in MREMD"
-c call flush(iout)
-c call MPI_Abort(MPI_COMM_WORLD,ERRCODE,ierr)
-c endif
-c do while (iex.eq.i)
-c write (iout,*) "upper",nupa(int(nupa(0,i)),i)
- iex=nupa(iran_num(1,int(nupa(0,i))),i)
-c enddo
-c write (iout,*) "nupa(0,i)",nupa(0,i)," iex",iex
- if (lmuca) then
- call muca_delta(remd_t_bath,remd_ene,i,iex,delta)
- else
-c Swap temperatures between conformations i and iex with recalculating the free energies
-c following temperature changes.
- ene_iex_iex=remd_ene(0,iex)
- ene_i_i=remd_ene(0,i)
-c write (iout,*) "i",i," ene_i_i",ene_i_i,
-c & " iex",iex," ene_iex_iex",ene_iex_iex
-c write (iout,*) "rescaling weights with temperature",
-c & remd_t_bath(i)
-c call flush(iout)
- call rescale_weights(remd_t_bath(i))
-
-c write (iout,*) "0,iex",remd_t_bath(i)
-c call enerprint(remd_ene(0,iex))
-
- call sum_energy(remd_ene(0,iex),.false.)
- ene_iex_i=remd_ene(0,iex)
-c write (iout,*) "ene_iex_i",remd_ene(0,iex)
-
-c write (iout,*) "0,i",remd_t_bath(i)
-c call enerprint(remd_ene(0,i))
-
- call sum_energy(remd_ene(0,i),.false.)
-c write (iout,*) "ene_i_i",remd_ene(0,i)
-c call flush(iout)
-c write (iout,*) "rescaling weights with temperature",
-c & remd_t_bath(iex)
- if (abs(ene_i_i-remd_ene(0,i)).gt.ene_tol) then
- write (iout,*) "ERROR: inconsistent energies:",i,
- & ene_i_i,remd_ene(0,i)
- endif
- call rescale_weights(remd_t_bath(iex))
-
-c write (iout,*) "0,i",remd_t_bath(iex)
-c call enerprint(remd_ene(0,i))
-
- call sum_energy(remd_ene(0,i),.false.)
-c write (iout,*) "ene_i_iex",remd_ene(0,i)
-c call flush(iout)
- ene_i_iex=remd_ene(0,i)
-
-c write (iout,*) "0,iex",remd_t_bath(iex)
-c call enerprint(remd_ene(0,iex))
-
- call sum_energy(remd_ene(0,iex),.false.)
- if (abs(ene_iex_iex-remd_ene(0,iex)).gt.ene_tol) then
- write (iout,*) "ERROR: inconsistent energies:",iex,
- & ene_iex_iex,remd_ene(0,iex)
- endif
-c write (iout,*) "ene_iex_iex",remd_ene(0,iex)
-c write (iout,*) "i",i," iex",iex
-c write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i,
-c & " ene_i_iex",ene_i_iex,
-c & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex
-c call flush(iout)
- delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))-
- & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i))
- delta=-delta
-c write(iout,*) 'delta',delta
-c delta=(remd_t_bath(i)-remd_t_bath(iex))*
-c & (remd_ene(i)-remd_ene(iex))/Rb/
-c & (remd_t_bath(i)*remd_t_bath(iex))
- endif
- if (delta .gt. 50.0d0) then
- delta=0.0d0
- else
-#ifdef OSF
- if(isnan(delta))then
- delta=0.0d0
- else if (delta.lt.-50.0d0) then
- delta=dexp(50.0d0)
- else
- delta=dexp(-delta)
- endif
-#else
- delta=dexp(-delta)
-#endif
- endif
- iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1
- xxx=ran_number(0.0d0,1.0d0)
-c write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx
-c call flush(iout)
- if (delta .gt. xxx) then
- tmp=remd_t_bath(i)
- remd_t_bath(i)=remd_t_bath(iex)
- remd_t_bath(iex)=tmp
- remd_ene(0,i)=ene_i_iex
- remd_ene(0,iex)=ene_iex_i
- if(lmuca) then
- tmp=elowi(i)
- elowi(i)=elowi(iex)
- elowi(iex)=tmp
- tmp=ehighi(i)
- ehighi(i)=ehighi(iex)
- ehighi(iex)=tmp
- endif
-
-
- do k=0,nodes
- itmp=nupa(k,i)
- nupa(k,i)=nupa(k,iex)
- nupa(k,iex)=itmp
- itmp=ndowna(k,i)
- ndowna(k,i)=ndowna(k,iex)
- ndowna(k,iex)=itmp
- enddo
- do il=1,nodes
- if (ifirst(il).eq.i) ifirst(il)=iex
- do k=1,nupa(0,il)
- if (nupa(k,il).eq.i) then
- nupa(k,il)=iex
- elseif (nupa(k,il).eq.iex) then
- nupa(k,il)=i
- endif
- enddo
- do k=1,ndowna(0,il)
- if (ndowna(k,il).eq.i) then
- ndowna(k,il)=iex
- elseif (ndowna(k,il).eq.iex) then
- ndowna(k,il)=i
- endif
- enddo
- enddo
-
- iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1
- itmp=i2rep(i-1)
- i2rep(i-1)=i2rep(iex-1)
- i2rep(iex-1)=itmp
-
-c write(iout,*) 'exchange',i,iex
-c write (iout,'(a8,100i4)') "@ ifirst",
-c & (ifirst(k),k=1,remd_m(1))
-c do il=1,nodes
-c write (iout,'(a8,i4,a1,100i4)') "@ nupa",il,":",
-c & (nupa(k,il),k=1,nupa(0,il))
-c write (iout,'(a8,i4,a1,100i4)') "@ ndowna",il,":",
-c & (ndowna(k,il),k=1,ndowna(0,il))
-c enddo
-c call flush(iout)
-
- else
- remd_ene(0,iex)=ene_iex_iex
- remd_ene(0,i)=ene_i_i
- i=iex
- endif
- endif
- enddo
- enddo
-cd write (iout,*) "exchange completed"
-cd call flush(iout)
- ELSEIF (usampl) THEN
- do ii=1,nodes
-cd write(iout,*) "########",ii
-
- i_temp=iran_num(1,nrep)
- i_mult=iran_num(1,remd_m(i_temp))
- i_iset=iran_num(1,nset)
- i_mset=iran_num(1,mset(i_iset))
- i=i_index(i_temp,i_mult,i_iset,i_mset)
-
-cd write(iout,*) "i=",i,i_temp,i_mult,i_iset,i_mset
-
- if(t_exchange_only)then
- i_dir=1
- else
- i_dir=iran_num(1,3)
- endif
-cd write(iout,*) "i_dir=",i_dir
-
- if(i_dir.eq.1 .and. remd_m(i_temp+1).gt.0 )then
-
- i_temp1=i_temp+1
- i_mult1=iran_num(1,remd_m(i_temp1))
- i_iset1=i_iset
- i_mset1=iran_num(1,mset(i_iset1))
- iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1)
-
- elseif(i_dir.eq.2 .and. mset(i_iset+1).gt.0)then
-
- i_temp1=i_temp
- i_mult1=iran_num(1,remd_m(i_temp1))
- i_iset1=i_iset+1
- i_mset1=iran_num(1,mset(i_iset1))
- iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1)
- econstr_temp_i=remd_ene(20,i)
- econstr_temp_iex=remd_ene(20,iex)
- remd_ene(20,i)=remd_ene(n_ene+3,i)
- remd_ene(20,iex)=remd_ene(n_ene+4,iex)
-
- elseif(remd_m(i_temp+1).gt.0.and.mset(i_iset+1).gt.0)then
-
- i_temp1=i_temp+1
- i_mult1=iran_num(1,remd_m(i_temp1))
- i_iset1=i_iset+1
- i_mset1=iran_num(1,mset(i_iset1))
- iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1)
- econstr_temp_i=remd_ene(20,i)
- econstr_temp_iex=remd_ene(20,iex)
- remd_ene(20,i)=remd_ene(n_ene+3,i)
- remd_ene(20,iex)=remd_ene(n_ene+4,iex)
-
- else
- goto 444
- endif
-
-cd write(iout,*) "iex=",iex,i_temp1,i_mult1,i_iset1,i_mset1
-ctime call flush(iout)
-
-c Swap temperatures between conformations i and iex with recalculating the free energies
-c following temperature changes.
- ene_iex_iex=remd_ene(0,iex)
- ene_i_i=remd_ene(0,i)
-co write (iout,*) "rescaling weights with temperature",
-co & remd_t_bath(i)
- call rescale_weights(remd_t_bath(i))
-
- call sum_energy(remd_ene(0,iex),.false.)
- ene_iex_i=remd_ene(0,iex)
-cd write (iout,*) "ene_iex_i",remd_ene(0,iex)
-c call sum_energy(remd_ene(0,i),.false.)
-cd write (iout,*) "ene_i_i",remd_ene(0,i)
-c write (iout,*) "rescaling weights with temperature",
-c & remd_t_bath(iex)
-c if (real(ene_i_i).ne.real(remd_ene(0,i))) then
-c write (iout,*) "ERROR: inconsistent energies:",i,
-c & ene_i_i,remd_ene(0,i)
-c endif
- call rescale_weights(remd_t_bath(iex))
- call sum_energy(remd_ene(0,i),.false.)
-cd write (iout,*) "ene_i_iex",remd_ene(0,i)
- ene_i_iex=remd_ene(0,i)
-c call sum_energy(remd_ene(0,iex),.false.)
-c if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then
-c write (iout,*) "ERROR: inconsistent energies:",iex,
-c & ene_iex_iex,remd_ene(0,iex)
-c endif
-cd write (iout,*) "ene_iex_iex",remd_ene(0,iex)
-c write (iout,*) "i",i," iex",iex
-cd write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i,
-cd & " ene_i_iex",ene_i_iex,
-cd & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex
- delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))-
- & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i))
- delta=-delta
-cd write(iout,*) 'delta',delta
-c delta=(remd_t_bath(i)-remd_t_bath(iex))*
-c & (remd_ene(i)-remd_ene(iex))/Rb/
-c & (remd_t_bath(i)*remd_t_bath(iex))
- if (delta .gt. 50.0d0) then
- delta=0.0d0
- else
- delta=dexp(-delta)
- endif
- if (i_dir.eq.1.or.i_dir.eq.3)
- & iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1
- if (i_dir.eq.2.or.i_dir.eq.3)
- & iremd_tot_usa(int(i2set(i-1)))=
- & iremd_tot_usa(int(i2set(i-1)))+1
- xxx=ran_number(0.0d0,1.0d0)
-cd write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx
- if (delta .gt. xxx) then
- tmp=remd_t_bath(i)
- remd_t_bath(i)=remd_t_bath(iex)
- remd_t_bath(iex)=tmp
-
- itmp=iremd_iset(i)
- iremd_iset(i)=iremd_iset(iex)
- iremd_iset(iex)=itmp
-
- remd_ene(0,i)=ene_i_iex
- remd_ene(0,iex)=ene_iex_i
-
- if (i_dir.eq.1.or.i_dir.eq.3)
- & iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1
-
- itmp=i2rep(i-1)
- i2rep(i-1)=i2rep(iex-1)
- i2rep(iex-1)=itmp
-
- if (i_dir.eq.2.or.i_dir.eq.3)
- & iremd_acc_usa(int(i2set(i-1)))=
- & iremd_acc_usa(int(i2set(i-1)))+1
-
- itmp=i2set(i-1)
- i2set(i-1)=i2set(iex-1)
- i2set(iex-1)=itmp
-
- itmp=i_index(i_temp,i_mult,i_iset,i_mset)
- i_index(i_temp,i_mult,i_iset,i_mset)=
- & i_index(i_temp1,i_mult1,i_iset1,i_mset1)
- i_index(i_temp1,i_mult1,i_iset1,i_mset1)=itmp
-
- else
- remd_ene(0,iex)=ene_iex_iex
- remd_ene(0,i)=ene_i_i
- remd_ene(20,iex)=econstr_temp_iex
- remd_ene(20,i)=econstr_temp_i
- endif
-
-cd do il=1,nset
-cd do il1=1,mset(il)
-cd do i=1,nrep
-cd do j=1,remd_m(i)
-cd write(iout,*) i,j,il,il1,i_index(i,j,il,il1)
-cd enddo
-cd enddo
-cd enddo
-cd enddo
-
- 444 continue
-
- enddo
-
- ELSEIF (hremd.gt.0) THEN
- do ii=1,nodes
-cd write(iout,*) "########",ii
-
- i_temp=iran_num(1,nrep)
- i_mult=iran_num(1,remd_m(i_temp))
- i_iset=iran_num(1,nset)
- i_mset=1
- i=i_index(i_temp,i_mult,i_iset,i_mset)
-
-cd write(iout,*) "i=",i,i_temp,i_mult,i_iset,i_mset
-
- if(t_exchange_only)then
- i_dir=1
- else
- i_dir=iran_num(1,3)
- endif
-
-cd write(iout,*) "i_dir=",i_dir
-
- if(i_dir.eq.1 .and. remd_m(i_temp+1).gt.0 )then
-
- i_temp1=i_temp+1
- i_mult1=iran_num(1,remd_m(i_temp1))
- i_iset1=i_iset
- i_mset1=1
- iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1)
-
- elseif(i_dir.eq.2)then
-
- i_temp1=i_temp
- i_mult1=iran_num(1,remd_m(i_temp1))
- i_iset1=iran_num(1,hremd)
- do while(i_iset1.eq.i_iset)
- i_iset1=iran_num(1,hremd)
- enddo
- i_mset1=1
- iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1)
-
- elseif(remd_m(i_temp+1).gt.0)then
-
- i_temp1=i_temp+1
- i_mult1=iran_num(1,remd_m(i_temp1))
- i_iset1=iran_num(1,hremd)
- do while(i_iset1.eq.i_iset)
- i_iset1=iran_num(1,hremd)
- enddo
- i_mset1=1
- iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1)
-
- else
- goto 445
- endif
-
-cd write(iout,*) "iex=",iex,i_temp1,i_mult1,i_iset1,i_mset1
-ctime call flush(iout)
-
-c Swap temperatures between conformations i and iex with recalculating the free energies
-c following temperature changes.
- ene_iex_iex=remd_ene(0,iex)
- ene_i_i=remd_ene(0,i)
-
- call set_hweights(i_iset)
- call rescale_weights(remd_t_bath(i))
- call sum_energy(remd_ene(0,iex),.false.)
- ene_iex_i=remd_ene(0,iex)
-
- call set_hweights(i_iset1)
- call rescale_weights(remd_t_bath(iex))
- call sum_energy(remd_ene(0,i),.false.)
- ene_i_iex=remd_ene(0,i)
-
-cd write(iout,*) ene_iex_iex,ene_i_i,ene_iex_i,ene_i_iex
-
- delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))-
- & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i))
- delta=-delta
-
- if (delta .gt. 50.0d0) then
- delta=0.0d0
- else
- delta=dexp(-delta)
- endif
-
- if (i_dir.eq.1.or.i_dir.eq.3)
- & iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1
- if (i_dir.eq.2.or.i_dir.eq.3)
- & iremd_tot_usa(int(i2set(i-1)))=
- & iremd_tot_usa(int(i2set(i-1)))+1
- xxx=ran_number(0.0d0,1.0d0)
-cd write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx
- if (delta .gt. xxx) then
-
-cd write (iout,*) "exchange"
- tmp=remd_t_bath(i)
- remd_t_bath(i)=remd_t_bath(iex)
- remd_t_bath(iex)=tmp
-
- itmp=iremd_iset(i)
- iremd_iset(i)=iremd_iset(iex)
- iremd_iset(iex)=itmp
-
- remd_ene(0,i)=ene_i_iex
- remd_ene(0,iex)=ene_iex_i
-
- if (i_dir.eq.1.or.i_dir.eq.3)
- & iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1
-
- itmp=i2rep(i-1)
- i2rep(i-1)=i2rep(iex-1)
- i2rep(iex-1)=itmp
-
- if (i_dir.eq.2.or.i_dir.eq.3)
- & iremd_acc_usa(int(i2set(i-1)))=
- & iremd_acc_usa(int(i2set(i-1)))+1
-
- itmp=i2set(i-1)
- i2set(i-1)=i2set(iex-1)
- i2set(iex-1)=itmp
-
- itmp=i_index(i_temp,i_mult,i_iset,i_mset)
- i_index(i_temp,i_mult,i_iset,i_mset)=
- & i_index(i_temp1,i_mult1,i_iset1,i_mset1)
- i_index(i_temp1,i_mult1,i_iset1,i_mset1)=itmp
-
-cd do il=1,nset
-cd do il1=1,mset(il)
-cd do i=1,nrep
-cd do j=1,remd_m(i)
-cd write(iout,*) i,j,il,il1,i_index(i,j,il,il1)
-cd enddo
-cd enddo
-cd enddo
-cd enddo
-
- else
- remd_ene(0,iex)=ene_iex_iex
- remd_ene(0,i)=ene_i_i
- endif
-
-
-
- 445 continue
-
- enddo
-
- ENDIF
-
-c-------------------------------------
- write (iout,*) "NREP",nrep
- do i=1,nrep
- if(iremd_tot(i).ne.0)
- & write(iout,'(a3,i4,2f12.5,i5)') 'ACC',i,remd_t(i)
- & ,iremd_acc(i)/(1.0*iremd_tot(i)),iremd_tot(i)
- enddo
-
- if(usampl) then
- do i=1,nset
- if(iremd_tot_usa(i).ne.0)
- & write(iout,'(a10,i4,f12.5,i8)') 'ACC_usampl',i,
- & iremd_acc_usa(i)/(1.0*iremd_tot_usa(i)),iremd_tot_usa(i)
- enddo
- endif
-
- if(hremd.gt.0) then
- do i=1,nset
- if(iremd_tot_usa(i).ne.0)
- & write(iout,'(a10,i4,f12.5,i8)') 'ACC_hremd',i,
- & iremd_acc_usa(i)/(1.0*iremd_tot_usa(i)),iremd_tot_usa(i)
- enddo
- endif
-
-
-ctime call flush(iout)
-
-cd write (iout,'(a6,100i4)') "ifirst",
-cd & (ifirst(i),i=1,remd_m(1))
-cd do il=1,nodes
-cd write (iout,'(a5,i4,a1,100i4)') "nup",il,":",
-cd & (nupa(i,il),i=1,nupa(0,il))
-cd write (iout,'(a5,i4,a1,100i4)') "ndown",il,":",
-cd & (ndowna(i,il),i=1,ndowna(0,il))
-cd enddo
- endif
-
- time06=MPI_WTIME()
-cd write (iout,*) "Before scatter"
-cd call flush(iout)
- call mpi_scatter(remd_t_bath,1,mpi_double_precision,
- & t_bath,1,mpi_double_precision,king,
- & CG_COMM,ierr)
-cd write (iout,*) "After scatter"
-cd call flush(iout)
- if(usampl.or.hremd.gt.0)
- & call mpi_scatter(iremd_iset,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
-
- time07=MPI_WTIME()
- if (me.eq.king .or. .not. out1file) then
- write(iout,*) 'REMD scatter time=',time07-time06
- endif
-
- if(lmuca) then
- call mpi_scatter(elowi,1,mpi_double_precision,
- & elow,1,mpi_double_precision,king,
- & CG_COMM,ierr)
- call mpi_scatter(ehighi,1,mpi_double_precision,
- & ehigh,1,mpi_double_precision,king,
- & CG_COMM,ierr)
- endif
-
- if(hremd.gt.0) call set_hweights(iset)
- call rescale_weights(t_bath)
-co write (iout,*) "Processor",me,
-co & " rescaling weights with temperature",t_bath
-
- stdfp=dsqrt(2*Rb*t_bath/d_time)
- do i=1,ntyp
- stdfsc(i)=dsqrt(2*Rb*t_bath/d_time)
- enddo
- if (lang.gt.0) then
- do i=nnt,nct-1
- stdforcp(i)=stdforcp(i)*sqrt(t_bath/t_bath_old)
- enddo
- do i=nnt,nct
- stdforcsc(i)=stdforcsc(i)*sqrt(t_bath/t_bath_old)
- enddo
- endif
-cde write(iout,*) 'REMD after',me,t_bath
- time08=MPI_WTIME()
- if (me.eq.king .or. .not. out1file) then
- write(iout,*) 'REMD exchange time=',time08-time02
-ctime call flush(iout)
- endif
- endif
- enddo
-
- if (restart1file) then
- if (me.eq.king .or. .not. out1file)
- & write(iout,*) 'writing restart at the end of run'
- call write1rst(i_index)
- endif
-
- if (traj1file) call write1traj
-cd debugging
-cdeb call mpi_gather(ntwx_cache,1,mpi_integer,
-cdeb & icache_all,1,mpi_integer,king,
-cdeb & CG_COMM,ierr)
-cdeb write(iout,'(a40,8000i8)')
-cdeb & ' ntwx_cache after traj1file at the end',
-cdeb & (icache_all(i),i=1,nodes)
-cd end
-
-
-#ifdef MPI
- t_MD=MPI_Wtime()-tt0
-#else
- t_MD=tcpu()-tt0
-#endif
- if (me.eq.king .or. .not. out1file) then
- write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))')
- & ' Timing ',
- & 'MD calculations setup:',t_MDsetup,
- & 'Energy & gradient evaluation:',t_enegrad,
- & 'Stochastic MD setup:',t_langsetup,
- & 'Stochastic MD step setup:',t_sdsetup,
- & 'MD steps:',t_MD
- write (iout,'(/28(1h=),a25,27(1h=))')
- & ' End of MD calculation '
- if(hmc.gt.0) write (iout,*) 'HMC acceptance ratio',
- & n_timestep*1.0d0/hmc/hmc_acc
- endif
- return
- end
-
-c-----------------------------------------------------------------------
- subroutine write1rst(i_index)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.SBRIDGE'
- include 'COMMON.INTERACT'
-
- real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres),
- & d_restart2(3,2*maxres*maxprocs)
- real t5_restart1(5)
- integer iret,itmp
- integer*2 i_index
- & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
- common /przechowalnia/ d_restart1,d_restart2
-
- t5_restart1(1)=totT
- t5_restart1(2)=EK
- t5_restart1(3)=potE
- t5_restart1(4)=t_bath
- t5_restart1(5)=Uconst
-
- call mpi_gather(t5_restart1,5,mpi_real,
- & t_restart1,5,mpi_real,king,CG_COMM,ierr)
-
-
- do i=1,2*nres
- do j=1,3
- r_d(j,i)=d_t(j,i)
- enddo
- enddo
- call mpi_gather(r_d,3*2*nres,mpi_real,
- & d_restart1,3*2*nres,mpi_real,king,
- & CG_COMM,ierr)
-
-
- do i=1,2*nres
- do j=1,3
- r_d(j,i)=dc(j,i)
- enddo
- enddo
- call mpi_gather(r_d,3*2*nres,mpi_real,
- & d_restart2,3*2*nres,mpi_real,king,
- & CG_COMM,ierr)
-
- if(me.eq.king) then
-#ifdef AIX
- call xdrfopen_(ixdrf,mremd_rst_name, "w", iret)
- do i=0,nodes-1
- call xdrfint_(ixdrf, i2rep(i), iret)
- enddo
- do i=1,remd_m(1)
- call xdrfint_(ixdrf, ifirst(i), iret)
- enddo
- do il=1,nodes
- do i=0,nupa(0,il)
- call xdrfint_(ixdrf, nupa(i,il), iret)
- enddo
-
- do i=0,ndowna(0,il)
- call xdrfint_(ixdrf, ndowna(i,il), iret)
- enddo
- enddo
-
- do il=1,nodes
- do j=1,4
- call xdrffloat_(ixdrf, t_restart1(j,il), iret)
- enddo
- enddo
-
- do il=0,nodes-1
- do i=1,2*nres
- do j=1,3
- call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret)
- enddo
- enddo
- enddo
- do il=0,nodes-1
- do i=1,2*nres
- do j=1,3
- call xdrffloat_(ixdrf, d_restart2(j,i+2*nres*il), iret)
- enddo
- enddo
- enddo
-
- if(usampl) then
- call xdrfint_(ixdrf, nset, iret)
- do i=1,nset
- call xdrfint_(ixdrf,mset(i), iret)
- enddo
- do i=0,nodes-1
- call xdrfint_(ixdrf,i2set(i), iret)
- enddo
- do il=1,nset
- do il1=1,mset(il)
- do i=1,nrep
- do j=1,remd_m(i)
- itmp=i_index(i,j,il,il1)
- call xdrfint_(ixdrf,itmp, iret)
- enddo
- enddo
- enddo
- enddo
-
- endif
- call xdrfclose_(ixdrf, iret)
-#else
- call xdrfopen(ixdrf,mremd_rst_name, "w", iret)
- do i=0,nodes-1
- call xdrfint(ixdrf, i2rep(i), iret)
- enddo
- do i=1,remd_m(1)
- call xdrfint(ixdrf, ifirst(i), iret)
- enddo
- do il=1,nodes
- do i=0,nupa(0,il)
- call xdrfint(ixdrf, nupa(i,il), iret)
- enddo
-
- do i=0,ndowna(0,il)
- call xdrfint(ixdrf, ndowna(i,il), iret)
- enddo
- enddo
-
- do il=1,nodes
- do j=1,4
- call xdrffloat(ixdrf, t_restart1(j,il), iret)
- enddo
- enddo
-
- do il=0,nodes-1
- do i=1,2*nres
- do j=1,3
- call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret)
- enddo
- enddo
- enddo
- do il=0,nodes-1
- do i=1,2*nres
- do j=1,3
- call xdrffloat(ixdrf, d_restart2(j,i+2*nres*il), iret)
- enddo
- enddo
- enddo
-
-
- if(usampl) then
- call xdrfint(ixdrf, nset, iret)
- do i=1,nset
- call xdrfint(ixdrf,mset(i), iret)
- enddo
- do i=0,nodes-1
- call xdrfint(ixdrf,i2set(i), iret)
- enddo
- do il=1,nset
- do il1=1,mset(il)
- do i=1,nrep
- do j=1,remd_m(i)
- itmp=i_index(i,j,il,il1)
- call xdrfint(ixdrf,itmp, iret)
- enddo
- enddo
- enddo
- enddo
-
- endif
- call xdrfclose(ixdrf, iret)
-#endif
- endif
- return
- end
-
-
- subroutine write1traj
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.SBRIDGE'
- include 'COMMON.INTERACT'
-
- real t5_restart1(5)
- integer iret,itmp
- real xcoord(3,maxres2+2),prec
- real r_qfrag(50),r_qpair(100)
- real r_utheta(50),r_ugamma(100),r_uscdiff(100)
- real p_qfrag(50*maxprocs),p_qpair(100*maxprocs)
- real p_utheta(50*maxprocs),p_ugamma(100*maxprocs),
- & p_uscdiff(100*maxprocs)
- real p_c(3,(maxres2+2)*maxprocs),r_c(3,maxres2+2)
- common /przechowalnia/ p_c
-
- call mpi_bcast(ii_write,1,mpi_integer,
- & king,CG_COMM,ierr)
-
-c debugging
- print *,'traj1file',me,ii_write,ntwx_cache
-c end debugging
-
-#ifdef AIX
- if(me.eq.king) call xdrfopen_(ixdrf,cartname, "a", iret)
-#else
- if(me.eq.king) call xdrfopen(ixdrf,cartname, "a", iret)
-#endif
- do ii=1,ii_write
- t5_restart1(1)=totT_cache(ii)
- t5_restart1(2)=EK_cache(ii)
- t5_restart1(3)=potE_cache(ii)
- t5_restart1(4)=t_bath_cache(ii)
- t5_restart1(5)=Uconst_cache(ii)
- call mpi_gather(t5_restart1,5,mpi_real,
- & t_restart1,5,mpi_real,king,CG_COMM,ierr)
-
- call mpi_gather(iset_cache(ii),1,mpi_integer,
- & iset_restart1,1,mpi_integer,king,CG_COMM,ierr)
-
- do i=1,nfrag
- r_qfrag(i)=qfrag_cache(i,ii)
- enddo
- do i=1,npair
- r_qpair(i)=qpair_cache(i,ii)
- enddo
- do i=1,nfrag_back
- r_utheta(i)=utheta_cache(i,ii)
- r_ugamma(i)=ugamma_cache(i,ii)
- r_uscdiff(i)=uscdiff_cache(i,ii)
- enddo
-
- call mpi_gather(r_qfrag,nfrag,mpi_real,
- & p_qfrag,nfrag,mpi_real,king,
- & CG_COMM,ierr)
- call mpi_gather(r_qpair,npair,mpi_real,
- & p_qpair,npair,mpi_real,king,
- & CG_COMM,ierr)
- call mpi_gather(r_utheta,nfrag_back,mpi_real,
- & p_utheta,nfrag_back,mpi_real,king,
- & CG_COMM,ierr)
- call mpi_gather(r_ugamma,nfrag_back,mpi_real,
- & p_ugamma,nfrag_back,mpi_real,king,
- & CG_COMM,ierr)
- call mpi_gather(r_uscdiff,nfrag_back,mpi_real,
- & p_uscdiff,nfrag_back,mpi_real,king,
- & CG_COMM,ierr)
-
-#ifdef DEBUG
- write (iout,*) "p_qfrag"
- do i=1,nodes
- write (iout,*) i,(p_qfrag((i-1)*nfrag+j),j=1,nfrag)
- enddo
- write (iout,*) "p_qpair"
- do i=1,nodes
- write (iout,*) i,(p_qpair((i-1)*npair+j),j=1,npair)
- enddo
-ctime call flush(iout)
-#endif
- do i=1,nres*2
- do j=1,3
- r_c(j,i)=c_cache(j,i,ii)
- enddo
- enddo
-
- call mpi_gather(r_c,3*2*nres,mpi_real,
- & p_c,3*2*nres,mpi_real,king,
- & CG_COMM,ierr)
-
- if(me.eq.king) then
-#ifdef AIX
- do il=1,nodes
- call xdrffloat_(ixdrf, real(t_restart1(1,il)), iret)
- call xdrffloat_(ixdrf, real(t_restart1(3,il)), iret)
- call xdrffloat_(ixdrf, real(t_restart1(5,il)), iret)
- call xdrffloat_(ixdrf, real(t_restart1(4,il)), iret)
- call xdrfint_(ixdrf, nss, iret)
- do j=1,nss
- if (dyn_ss) then
- call xdrfint(ixdrf, idssb(j)+nres, iret)
- call xdrfint(ixdrf, jdssb(j)+nres, iret)
- else
- call xdrfint_(ixdrf, ihpb(j), iret)
- call xdrfint_(ixdrf, jhpb(j), iret)
- endif
- enddo
- call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
- call xdrfint_(ixdrf, iset_restart1(il), iret)
- do i=1,nfrag
- call xdrffloat_(ixdrf, p_qfrag(i+(il-1)*nfrag), iret)
- enddo
- do i=1,npair
- call xdrffloat_(ixdrf, p_qpair(i+(il-1)*npair), iret)
- enddo
- do i=1,nfrag_back
- call xdrffloat_(ixdrf, p_utheta(i+(il-1)*nfrag_back), iret)
- call xdrffloat_(ixdrf, p_ugamma(i+(il-1)*nfrag_back), iret)
- call xdrffloat_(ixdrf, p_uscdiff(i+(il-1)*nfrag_back), iret)
- enddo
- prec=10000.0
- do i=1,nres
- do j=1,3
- xcoord(j,i)=p_c(j,i+(il-1)*nres*2)
- enddo
- enddo
- do i=nnt,nct
- do j=1,3
- xcoord(j,nres+i-nnt+1)=p_c(j,i+nres+(il-1)*nres*2)
- enddo
- enddo
- itmp=nres+nct-nnt+1
- call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
- enddo
-#else
- do il=1,nodes
- call xdrffloat(ixdrf, real(t_restart1(1,il)), iret)
- call xdrffloat(ixdrf, real(t_restart1(3,il)), iret)
- call xdrffloat(ixdrf, real(t_restart1(5,il)), iret)
- call xdrffloat(ixdrf, real(t_restart1(4,il)), iret)
- call xdrfint(ixdrf, nss, iret)
- do j=1,nss
- if (dyn_ss) then
- call xdrfint(ixdrf, idssb(j)+nres, iret)
- call xdrfint(ixdrf, jdssb(j)+nres, iret)
- else
- call xdrfint(ixdrf, ihpb(j), iret)
- call xdrfint(ixdrf, jhpb(j), iret)
- endif
- enddo
- call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
- call xdrfint(ixdrf, iset_restart1(il), iret)
- do i=1,nfrag
- call xdrffloat(ixdrf, p_qfrag(i+(il-1)*nfrag), iret)
- enddo
- do i=1,npair
- call xdrffloat(ixdrf, p_qpair(i+(il-1)*npair), iret)
- enddo
- do i=1,nfrag_back
- call xdrffloat(ixdrf, p_utheta(i+(il-1)*nfrag_back), iret)
- call xdrffloat(ixdrf, p_ugamma(i+(il-1)*nfrag_back), iret)
- call xdrffloat(ixdrf, p_uscdiff(i+(il-1)*nfrag_back), iret)
- enddo
- prec=10000.0
- do i=1,nres
- do j=1,3
- xcoord(j,i)=p_c(j,i+(il-1)*nres*2)
- enddo
- enddo
- do i=nnt,nct
- do j=1,3
- xcoord(j,nres+i-nnt+1)=p_c(j,i+nres+(il-1)*nres*2)
- enddo
- enddo
- itmp=nres+nct-nnt+1
- call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
- enddo
-#endif
- endif
- enddo
-#ifdef AIX
- if(me.eq.king) call xdrfclose_(ixdrf, iret)
-#else
- if(me.eq.king) call xdrfclose(ixdrf, iret)
-#endif
- do i=1,ntwx_cache-ii_write
-
- totT_cache(i)=totT_cache(ii_write+i)
- EK_cache(i)=EK_cache(ii_write+i)
- potE_cache(i)=potE_cache(ii_write+i)
- t_bath_cache(i)=t_bath_cache(ii_write+i)
- Uconst_cache(i)=Uconst_cache(ii_write+i)
- iset_cache(i)=iset_cache(ii_write+i)
-
- do ii=1,nfrag
- qfrag_cache(ii,i)=qfrag_cache(ii,ii_write+i)
- enddo
- do ii=1,npair
- qpair_cache(ii,i)=qpair_cache(ii,ii_write+i)
- enddo
- do ii=1,nfrag_back
- utheta_cache(ii,i)=utheta_cache(ii,ii_write+i)
- ugamma_cache(ii,i)=ugamma_cache(ii,ii_write+i)
- uscdiff_cache(ii,i)=uscdiff_cache(ii,ii_write+i)
- enddo
-
- do ii=1,nres*2
- do j=1,3
- c_cache(j,ii,i)=c_cache(j,ii,ii_write+i)
- enddo
- enddo
- enddo
- ntwx_cache=ntwx_cache-ii_write
- return
- end
-
-
- subroutine read1restart(i_index)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.SBRIDGE'
- include 'COMMON.INTERACT'
- real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres),
- & t5_restart1(5)
- integer*2 i_index
- & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
- common /przechowalnia/ d_restart1
- write (*,*) "Processor",me," called read1restart"
-
- if(me.eq.king)then
- open(irest2,file=mremd_rst_name,status='unknown')
- read(irest2,*,err=334) i
- write(iout,*) "Reading old rst in ASCI format"
- close(irest2)
- call read1restart_old
- return
- 334 continue
-#ifdef AIX
- call xdrfopen_(ixdrf,mremd_rst_name, "r", iret)
-
- do i=0,nodes-1
- call xdrfint_(ixdrf, i2rep(i), iret)
- enddo
- do i=1,remd_m(1)
- call xdrfint_(ixdrf, ifirst(i), iret)
- enddo
- do il=1,nodes
- call xdrfint_(ixdrf, nupa(0,il), iret)
- do i=1,nupa(0,il)
- call xdrfint_(ixdrf, nupa(i,il), iret)
- enddo
-
- call xdrfint_(ixdrf, ndowna(0,il), iret)
- do i=1,ndowna(0,il)
- call xdrfint_(ixdrf, ndowna(i,il), iret)
- enddo
- enddo
- do il=1,nodes
- do j=1,4
- call xdrffloat_(ixdrf, t_restart1(j,il), iret)
- enddo
- enddo
-#else
- call xdrfopen(ixdrf,mremd_rst_name, "r", iret)
-
- do i=0,nodes-1
- call xdrfint(ixdrf, i2rep(i), iret)
- enddo
- do i=1,remd_m(1)
- call xdrfint(ixdrf, ifirst(i), iret)
- enddo
- do il=1,nodes
- call xdrfint(ixdrf, nupa(0,il), iret)
- do i=1,nupa(0,il)
- call xdrfint(ixdrf, nupa(i,il), iret)
- enddo
-
- call xdrfint(ixdrf, ndowna(0,il), iret)
- do i=1,ndowna(0,il)
- call xdrfint(ixdrf, ndowna(i,il), iret)
- enddo
- enddo
- do il=1,nodes
- do j=1,4
- call xdrffloat(ixdrf, t_restart1(j,il), iret)
- enddo
- enddo
-#endif
- endif
- call mpi_scatter(t_restart1,5,mpi_real,
- & t5_restart1,5,mpi_real,king,CG_COMM,ierr)
- totT=t5_restart1(1)
- EK=t5_restart1(2)
- potE=t5_restart1(3)
- t_bath=t5_restart1(4)
-
- if(me.eq.king)then
- do il=0,nodes-1
- do i=1,2*nres
-c read(irest2,'(3e15.5)')
-c & (d_restart1(j,i+2*nres*il),j=1,3)
- do j=1,3
-#ifdef AIX
- call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret)
-#else
- call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret)
-#endif
- enddo
- enddo
- enddo
- endif
- call mpi_scatter(d_restart1,3*2*nres,mpi_real,
- & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
-
- do i=1,2*nres
- do j=1,3
- d_t(j,i)=r_d(j,i)
- enddo
- enddo
- if(me.eq.king)then
- do il=0,nodes-1
- do i=1,2*nres
-c read(irest2,'(3e15.5)')
-c & (d_restart1(j,i+2*nres*il),j=1,3)
- do j=1,3
-#ifdef AIX
- call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret)
-#else
- call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret)
-#endif
- enddo
- enddo
- enddo
- endif
- call mpi_scatter(d_restart1,3*2*nres,mpi_real,
- & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
- do i=1,2*nres
- do j=1,3
- dc(j,i)=r_d(j,i)
- enddo
- enddo
-
-
- if(usampl) then
-#ifdef AIX
- if(me.eq.king)then
- call xdrfint_(ixdrf, nset, iret)
- do i=1,nset
- call xdrfint_(ixdrf,mset(i), iret)
- enddo
- do i=0,nodes-1
- call xdrfint_(ixdrf,i2set(i), iret)
- enddo
- do il=1,nset
- do il1=1,mset(il)
- do i=1,nrep
- do j=1,remd_m(i)
- call xdrfint_(ixdrf,itmp, iret)
- i_index(i,j,il,il1)=itmp
- enddo
- enddo
- enddo
- enddo
- endif
-#else
- if(me.eq.king)then
- call xdrfint(ixdrf, nset, iret)
- do i=1,nset
- call xdrfint(ixdrf,mset(i), iret)
- enddo
- do i=0,nodes-1
- call xdrfint(ixdrf,i2set(i), iret)
- enddo
- do il=1,nset
- do il1=1,mset(il)
- do i=1,nrep
- do j=1,remd_m(i)
- call xdrfint(ixdrf,itmp, iret)
- i_index(i,j,il,il1)=itmp
- enddo
- enddo
- enddo
- enddo
- endif
-#endif
- call mpi_scatter(i2set,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
-
- endif
-
-
- if(me.eq.king) close(irest2)
- return
- end
-
- subroutine read1restart_old
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.SBRIDGE'
- include 'COMMON.INTERACT'
- real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres),
- & t5_restart1(5)
- common /przechowalnia/ d_restart1
- if(me.eq.king)then
- open(irest2,file=mremd_rst_name,status='unknown')
- read (irest2,*) (i2rep(i),i=0,nodes-1)
- read (irest2,*) (ifirst(i),i=1,remd_m(1))
- do il=1,nodes
- read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il))
- read (irest2,*) ndowna(0,il),
- & (ndowna(i,il),i=1,ndowna(0,il))
- enddo
- do il=1,nodes
- read(irest2,*) (t_restart1(j,il),j=1,4)
- enddo
- endif
- call mpi_scatter(t_restart1,5,mpi_real,
- & t5_restart1,5,mpi_real,king,CG_COMM,ierr)
- totT=t5_restart1(1)
- EK=t5_restart1(2)
- potE=t5_restart1(3)
- t_bath=t5_restart1(4)
-
- if(me.eq.king)then
- do il=0,nodes-1
- do i=1,2*nres
- read(irest2,'(3e15.5)')
- & (d_restart1(j,i+2*nres*il),j=1,3)
- enddo
- enddo
- endif
- call mpi_scatter(d_restart1,3*2*nres,mpi_real,
- & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
-
- do i=1,2*nres
- do j=1,3
- d_t(j,i)=r_d(j,i)
- enddo
- enddo
- if(me.eq.king)then
- do il=0,nodes-1
- do i=1,2*nres
- read(irest2,'(3e15.5)')
- & (d_restart1(j,i+2*nres*il),j=1,3)
- enddo
- enddo
- endif
- call mpi_scatter(d_restart1,3*2*nres,mpi_real,
- & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr)
- do i=1,2*nres
- do j=1,3
- dc(j,i)=r_d(j,i)
- enddo
- enddo
- if(me.eq.king) close(irest2)
- return
- end
-c-------------------------------------------------------------------
- subroutine set_hweights(iiset)
- implicit real*8 (a-h,o-z)
- integer i
- include 'DIMENSIONS'
- include 'COMMON.FFIELD'
- include 'COMMON.REMD'
-
- do i=1,n_ene
- weights(i)=hweights(iiset,i)
- enddo
-
- wsc =weights(1)
- wscp =weights(2)
- welec =weights(3)
- wcorr =weights(4)
- wcorr5 =weights(5)
- wcorr6 =weights(6)
- wel_loc=weights(7)
- wturn3 =weights(8)
- wturn4 =weights(9)
- wturn6 =weights(10)
- wang =weights(11)
- wscloc =weights(12)
- wtor =weights(13)
- wtor_d =weights(14)
- wstrain=weights(15)
- wvdwpp =weights(16)
- wbond =weights(17)
- scal14 =weights(18)
- wsccor =weights(21)
-
- return
- end
-#endif
+++ /dev/null
-Makefile_MPICH_ifort
\ No newline at end of file
+++ /dev/null
-#
-FC1=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77
-FC=tau_f90.sh
-OPT = -O3 -qarch=450 -qtune=450 -qfixed
-#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed
-#OPT = -O -qarch=450 -qtune=450 -qfixed
-#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \
-#-Mprefetch=distance:8,nta
-
-#OPT = -O0 -C -g -qarch=450 -qtune=450 -qfixed
-OPT1 = -O0 -g -qarch=450 -qtune=450 -qfixed
-OPT2 = -O2 -qarch=450 -qtune=450 -qfixed
-#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed
-#OPT2 = ${OPT}
-OPTE = -O4 -qarch=450 -qtune=450 -qfixed
-#OPTE = -O4 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed
-#OPTE=${OPT}
-
-FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
-FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include
-FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include
-FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include
-
-BIN = ../bin/unres_MD_Tc_procor-newparm-gnivpar-O4-test.exe
-#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a
-LIBS = xdrf/libxdrf.a
-
-CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \
- -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-
-all: unres
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new.o \
- energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \
- indexx.o MP.o compare_s1.o prng.o \
- test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o
-
-unres: ${object}
- ${CC} -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} --print-map ${object} cinfo.o ${LIBS} -o ${BIN}
-
-
-clean:
- /bin/rm *.o; /bin/rm *.pp.*
-
-newconf.o: newconf.f
- ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f
-
-bank.o: bank.F
- ${FC} ${FFLAGS} ${CPPFLAGS} bank.F
-
-diff12.o: diff12.f
- ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f
-
-csa.o: csa.f
- ${FC} ${FFLAGS} ${CPPFLAGS} csa.f
-
-shift.o: shift.F
- ${FC} ${FFLAGS} ${CPPFLAGS} shift.F
-
-ran.o: ran.f
- ${FC} ${FFLAGS} ${CPPFLAGS} ran.f
-
-together.o: together.F
- ${FC} ${FFLAGS} ${CPPFLAGS} together.F
-
-test.o: test.F
- ${FC} ${FFLAGS} ${CPPFLAGS} test.F
-
-chainbuild.o: chainbuild.F
- ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
-
-matmult.o: matmult.f
- ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
-
-parmread.o : parmread.F
- ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
-
-intcor.o : intcor.f
- ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
-
-cartder.o : cartder.F
- ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
-
-readpdb.o : readpdb.f
- ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f
-
-sumsld.o : sumsld.f
- ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
-
-cored.o : cored.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f
-
-rmdd.o : rmdd.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} rmdd.f
-
-eigen.o : eigen.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f
-
-blas.o : blas.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f
-
-add.o : add.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} add.f
-
-energy_p_new.o : energy_p_new.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F
-
-energy_p_new-sep.o : energy_p_new-sep.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F
-
-lagrangian_lesyng.o : lagrangian_lesyng.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F
-
-compinfo: compinfo.o
- ${CC} ${CFLAGS} compfinfo.c
-
-proc_proc.o: proc_proc.c
- ${CC} ${CFLAGS} proc_proc.c
-
-prng_32.o: prng_32.F
- ${FC} -qfixed -O0 prng_32.F
-
-prng.o: prng.f
- ${FC1} ${FFLAGS} prng.f
-
-readrtns_CSA.o: readrtns_CSA.F
- ${FC1} ${FFLAGS} ${CPPFLAGS} readrtns_CSA.F
-
-gen_rand_conf.o: gen_rand_conf.F
- ${FC1} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F
+++ /dev/null
-#****************************************************************************
-#* TAU Portable Profiling Package **
-#* http://www.cs.uoregon.edu/research/tau **
-#****************************************************************************
-#* Copyright 1997-2002 **
-#* Department of Computer and Information Science, University of Oregon **
-#* Advanced Computing Laboratory, Los Alamos National Laboratory **
-#****************************************************************************
-#######################################################################
-## pC++/Sage++ Copyright (C) 1993,1995 ##
-## Indiana University University of Oregon University of Rennes ##
-#######################################################################
-
-#######################################################################
-# This is a sample Makefile that contains the Profiling and Tracing
-# options. Makefiles of other applications and libraries (not included
-# in this distribution) should include this Makefile.
-# It defines the following variables that should be added to CFLAGS
-# TAU_INCLUDE - Include path for tau headers
-# TAU_DEFS - Defines that are needed for tracing and profiling only.
-# And for linking add to LIBS
-# TAU_LIBS - TAU Tracing and Profiling library libprof.a
-#
-# When the user needs to turn off tracing and profiling and run the
-# application without any runtime overhead of instrumentation, simply
-# remove TAUDEFS and TAULIBS from CFLAGS and LIBS respectively but keep
-# TAUINC.
-#######################################################################
-
-########### Automatically modified by the configure script ############
-CONFIG_ARCH=bgp
-TAU_ARCH=bgp
-CONFIG_CC=bgxlc_r
-CONFIG_CXX=bgxlC_r
-TAU_CC_FE=$(CONFIG_CC)
-TAU_CXX_FE=$(CONFIG_CXX)
-
-# Front end C/C++ Compilers
-#BGL#TAU_CC_FE=xlc #ENDIF#
-#BGL#TAU_CXX_FE=xlC #ENDIF#
-TAU_CC_FE=xlc #ENDIF##BGP#
-TAU_CXX_FE=xlC #ENDIF##BGP#
-#CATAMOUNT#TAU_CC_FE=gcc #ENDIF#
-#CATAMOUNT#TAU_CXX_FE=g++ #ENDIF#
-#SC_GFORTRAN#TAU_CC_FE=gcc #ENDIF#
-#SC_GFORTRAN#TAU_CXX_FE=g++ #ENDIF#
-#SC_PATHSCALE#TAU_CC_FE=gcc #ENDIF#
-#SC_PATHSCALE#TAU_CXX_FE=g++ #ENDIF#
-
-PCXX_OPT=-g
-USER_OPT=
-EXTRADIR=/opt/ibmcmp/xlf/bg/11.1/bin/..
-EXTRADIRCXX=/opt/ibmcmp/vacpp/bg/9.0/bin/..
-TAUROOT=/soft/apps/tau/tau_latest
-TULIPDIR=
-TAUEXTRASHLIBOPTS=
-TAUGCCLIBOPTS=
-TAUGCCLIBDIR=
-TAUGFORTRANLIBDIR=
-PCLDIR=
-PAPIDIR=
-PAPISUBDIR=
-CHARMDIR=
-PDTDIR=/soft/apps/tau/pdtoolkit-3.12
-PDTCOMPDIR=
-DYNINSTDIR=
-JDKDIR=
-SLOG2DIR=
-OPARIDIR=
-TAU_OPARI_TOOL=
-EPILOGDIR=
-EPILOGBINDIR=
-EPILOGINCDIR=
-EPILOGLIBDIR=
-EPILOGEXTRALINKCMD=
-VAMPIRTRACEDIR=
-KTAU_INCDIR=
-KTAU_INCUSERDIR=
-KTAU_LIB=
-KTAU_KALLSYMS_PATH=
-PYTHON_INCDIR=
-PYTHON_LIBDIR=
-PERFINCDIR=
-PERFLIBDIR=
-PERFLIBRARY=
-TAU_SHMEM_INC=
-TAU_SHMEM_LIB=
-TAU_CONFIG=-mpi-pdt
-TAU_MPI_INC=-I/bgsys/drivers/ppcfloor/comm/include
-TAU_MPI_LIB=-L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib
-TAU_MPI_FLIB=-lfmpich.cnk -L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib
-TAU_MPILIB_DIR=/bgsys/drivers/ppcfloor/comm/lib
-TAU_MPI_NOWRAP_LIB= -L/bgsys/drivers/ppcfloor/comm/lib
-TAU_MPI_NOWRAP_FLIB=-lfmpich.cnk -L/bgsys/drivers/ppcfloor/comm/lib
-FULL_CXX=mpixlcxx_r
-FULL_CC=mpixlc_r
-TAU_PREFIX_INSTALL_DIR=/soft/apps/tau/tau_latest
-
-TAU_BIN_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/bin
-TAU_INC_DIR=$(TAU_PREFIX_INSTALL_DIR)/include
-TAU_LIB_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/lib
-
-#######################################################################
-
-#OPARI#TAU_OPARI_TOOL=$(TAU_BIN_DIR)/opari #ENDIF#
-#ENABLE64BIT#ABI = -64 #ENDIF#
-#ENABLEN32BIT#ABI = -n32 #ENDIF#
-#ENABLE32BIT#ABI = -32 #ENDIF#
-
-#######################################################################
-#SP1#IBM_XLC_ABI = -q32 #ENDIF#
-#SP1#IBM_GNU_ABI = -maix32 #ENDIF#
-#IBM64#IBM_XLC_ABI = -q64 #ENDIF#
-#IBM64#IBM_GNU_ABI = -maix64 #ENDIF#
-#IBM64LINUX#IBM_XLC_ABI = -q64 #ENDIF#
-#IBM64LINUX#IBM_GNU_ABI = -m64 #ENDIF#
-#SUNX86_64#SUN_GNU_ABI = -m64 #ENDIF#
-#SUNX86_64#SUN_CC_ABI = -xarch=amd64 #ENDIF#
-#MIPS32LINUX#SC_GNU_ABI = -mabi=n32 #ENDIF#
-#MIPS32LINUX#SC_PATH_ABI = -n32 #ENDIF#
-#MIPS64LINUX#SC_GNU_ABI = -mabi=64 #ENDIF#
-#MIPS64LINUX#SC_PATH_ABI = -64 #ENDIF#
-#GNU#SC_ABI = $(SC_GNU_ABI) #ENDIF#
-#USE_PATHCC#SC_ABI = $(SC_PATH_ABI) #ENDIF#
-#MIPS32#ABI = $(SC_ABI) #ENDIF#
-#MIPS64#ABI = $(SC_ABI) #ENDIF#
-
-IBM_ABI = $(IBM_XLC_ABI) #ENDIF##USE_IBMXLC#
-#GNU#IBM_ABI = $(IBM_GNU_ABI) #ENDIF#
-#SP1# ABI = $(IBM_ABI) #ENDIF#
-#PPC64# ABI = $(IBM_ABI) #ENDIF#
-#SOLARIS64#SUN_GNU_ABI = -mcpu=v9 -m64 #ENDIF#
-#SOLARIS64#SUN_CC_ABI = -xarch=v9 -xcode=pic32 #ENDIF#
-#SOL2CC#SUN_ABI = $(SUN_CC_ABI) #ENDIF#
-#GNU#SUN_ABI = $(SUN_GNU_ABI) #ENDIF#
-#SOL2#ABI = $(SUN_ABI) #ENDIF#
-#SUNX86_64#ABI = $(SUN_ABI) #ENDIF#
-#FORCEIA32#ABI = -m32#ENDIF#
-#######################################################################
-F90_ABI = $(ABI)
-#IBM64_FORTRAN#F90_ABI = -q64 #ENDIF#
-#######################################################################
-
-############# Standard Defines ##############
-TAU_CC = $(CONFIG_CC) $(ABI) $(ISA)
-TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT)
-TAU_RUN_CC = $(FULL_CC) $(ABI) $(ISA)
-TAU_RUN_CXX = $(FULL_CXX) $(ABI) $(ISA)
-TAU_INSTALL = /bin/cp
-TAU_SHELL = /bin/sh
-LSX = .a
-#############################################
-# JAVA DEFAULT ARCH
-#############################################
-JDKARCH = linux
-#COMPAQ_ALPHA#JDKARCH = alpha #ENDIF#
-#SOL2#JDKARCH = solaris #ENDIF#
-#SGIMP#JDKARCH = irix #ENDIF#
-#SP1#JDKARCH = aix #ENDIF#
-#T3E#JDKARCH = cray #ENDIF#
-#############################################
-# JAVA OBJECTS
-#############################################
-#JAVA#TAU_JAVA_O = TauJava.o TauJAPI.o #ENDIF#
-#JAVA#TAUJAPI = Profile.class #ENDIF#
-
-
-#############################################
-# OpenMP OBJECTS
-#############################################
-#OPENMP#OPENMP_O = OpenMPLayer.o #ENDIF#
-
-#############################################
-# Opari OBJECTS
-#############################################
-#OPARI#OPARI_O = TauOpari.o #ENDIF#
-#KOJAKOPARI#OPARI_O = TauKojakOpari.o #ENDIF#
-#EPILOG#OPARI_O = #ENDIF#
-#VAMPIRTRACE#OPARI_O = #ENDIF#
-#GNU#OPARI_O = #ENDIF#
-
-#############################################
-# CallPath OBJECTS
-#############################################
-#PROFILECALLPATH#CALLPATH_O = TauCallPath.o #ENDIF#
-#PROFILEPARAM#PARAM_O = ProfileParam.o #ENDIF#
-
-#############################################
-# Python Binding OBJECTS
-#############################################
-#PYTHON#PYTHON_O = PyGroups.o PyExceptions.o PyDatabase.o PyBindings.o PyTimer.o PyTau.o #ENDIF#
-
-#############################################
-# DYNINST DEFAULT ARCH
-#############################################
-DYNINST_PLATFORM = $(PLATFORM)
-
-
-#PCL##include $(TAU_INC_DIR)/makefiles/PCLMakefile.stub #ENDIF#
-
-############# OpenMP Fortran Option ########
-#OPENMP#TAU_F90_OPT = -mp #ENDIF#
-#SOL2CC_OPENMP#TAU_F90_OPT = -xopenmp #ENDIF#
-#SUNCC_OPENMP#TAU_F90_OPT = -xopenmp=parallel #ENDIF#
-#COMPAQCXX_OPENMP#TAU_F90_OPT = -omp #ENDIF#
-#IBMXLC_OPENMP#TAU_F90_OPT = -qsmp=omp #ENDIF#
-#GUIDE#TAU_F90_OPT = #ENDIF#
-#PGIOPENMP#TAU_F90_OPT = -mp #ENDIF#
-#INTELOPENMP#TAU_F90_OPT = -openmp #ENDIF#
-#HITACHI_OPENMP#TAU_F90_OPT = #ENDIF#
-
-TAU_R =_r #ENDIF##THREADSAFE_COMPILERS#
-
-############# Fortran Compiler #############
-#GNU_FORTRAN#TAU_F90 = g77 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#GNU_GFORTRAN#TAU_F90 = gfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#G95_FORTRAN#TAU_F90 = g95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#SC_GFORTRAN#TAU_F90 = scgfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#SGI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-TAU_F90 = xlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##IBM_FORTRAN#
-TAU_F90 = mpixlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##BGP#
-#BGL#TAU_F90 = blrts_xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#IBM64_FORTRAN#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#IBMXLFAPPLE#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#CRAY_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#CRAY_X1_FORTRAN#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#PGI_FORTRAN#TAU_F90 = pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#CRAYCNL#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#PGI_CATAMOUNT#TAU_F90 = qk-pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#ABSOFT_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#LAHEY_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#LAHEY64_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#NAGWARE_FORTRAN#TAU_F90 = f95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#FUJITSU_FORTRAN#TAU_F90 = F90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#FUJITSU_SOLARIS#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#SUN_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#COMPAQ_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#KAI_FORTRAN#TAU_F90 = guidef90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#HP_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#HITACHI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#INTEL_FORTRAN#TAU_F90 = efc $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#INTEL32_FORTRAN#TAU_F90 = ifc $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#INTELIFORT#TAU_F90 = ifort $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#PATHSCALE_FORTRAN#TAU_F90 = pathf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#SC_PATHSCALE#TAU_F90 = scpathf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#OPEN64ORC_FORTRAN#TAU_F90 = orf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-#NEC_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF#
-
-
-############# Portable F90 Options #############
-#IBM64_FORTRAN#TAU_F90_FIXED = -qfixed #ENDIF#
-TAU_F90_FIXED = -qfixed #ENDIF##IBM_FORTRAN#
-TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF##IBM_FORTRAN#
-#IBMXLFAPPLE#TAU_F90_FIXED = -qfixed #ENDIF#
-#IBMXLFAPPLE#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF#
-#IBM64_FORTRAN#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF#
-
-############# Profiling Options #############
-PROFILEOPT1 = -DPROFILING_ON #ENDIF##PROFILE#
-#PCL#PROFILEOPT3 = -DTAU_PCL -I$(PCLDIR)/include #ENDIF#
-#PAPI#PROFILEOPT3 = -DTAU_PAPI -I$(PAPIDIR)/src -I$(PAPIDIR)/include #ENDIF#
-#PCL#PCL_O = PclLayer.o #ENDIF#
-#PAPI#PAPI_O = PapiLayer.o #ENDIF#
-#MULTIPLECOUNTERS#MULT_O = MultipleCounters.o #ENDIF#
-#PROFILECALLS#PROFILEOPT4 = -DPROFILE_CALLS #ENDIF#
-#PROFILESTATS#PROFILEOPT5 = -DPROFILE_STATS #ENDIF#
-#DEBUGPROF#PROFILEOPT6 = -DDEBUG_PROF #ENDIF#
-PROFILEOPT7 = -DTAU_STDCXXLIB #ENDIF##STDCXXLIB#
-#CRAYX1CC#PROFILEOPT7 = #ENDIF#
-#CRAYCC#PROFILEOPT7 = #ENDIF#
-#INTELTFLOP#PROFILEOPT8 = -DPOOMA_TFLOP #ENDIF#
-#NORTTI#PROFILEOPT9 = -DNO_RTTI #ENDIF#
-#RTTI#PROFILEOPT9 = -DRTTI #ENDIF#
-#GNU#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF#
-#APPLECXX#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF#
-#SOL2CC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF#
-#SUNCC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF#
-#USE_PATHCC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -fPIC -DTAU_PATHSCALE #ENDIF#
-#OPEN64ORC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -DTAU_OPEN64ORC -fpic #ENDIF#
-#CALLSTACK#PROFILEOPT11 = -DPROFILE_CALLSTACK #ENDIF#
-#PGI1.7#PROFILEOPT12 = -DPGI #ENDIF#
-#CRAYKAI#PROFILEOPT12 = -DCRAYKAI #ENDIF#
-#HP_FORTRAN#PROFILEOPT12 = -DHP_FORTRAN #ENDIF#
-#CRAYCC#PROFILEOPT13 = -h instantiate=used -DCRAYCC -DTAU_DOT_H_LESS_HEADERS #ENDIF#
-#CRAYX1CC#PROFILEOPT13 = -DTAU_DOT_H_LESS_HEADERS #ENDIF#
-#SGICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -LANG:std #ENDIF#
-#INTELCXXLIBICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -cxxlib-icc #ENDIF#
-#PTHREAD_AVAILABLE#PROFILEOPT15 = -DPTHREADS #ENDIF#
-#COMPAQCXX_PTHREAD#PROFILEOPT15 = -DPTHREADS -pthread #ENDIF#
-#TAU_SPROC#PROFILEOPT15 = -DTAU_SPROC #ENDIF#
-#TAU_PAPI_THREADS#PROFILEOPT15 = -DTAU_PAPI_THREADS #ENDIF#
-#TULIPTHREADS#PROFILEOPT16 = -DTULIPTHREADS #ENDIF#
-#TRACE#TRACEOPT = -DTRACING_ON #ENDIF#
-#TRACE#EVENTS_O = Tracer.o #ENDIF#
-#KTAU#KTAU_O = TauKtau.o KtauProfiler.o KtauSymbols.o #ENDIF#
-#KTAU_MERGE#KTAU_MERGE_O = KtauFuncInfo.o KtauMergeInfo.o ktau_syscall.o #ENDIF#
-#KTAU_SHCTR#KTAU_SHCTR_O = KtauCounters.o #ENDIF#
-#MPITRACE#TRACEOPT = -DTAU_MPITRACE -DTRACING_ON #ENDIF#
-#MPITRACE#EVENTS_O = Tracer.o #ENDIF#
-#MUSE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF#
-#MUSE_EVENT#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF#
-#MUSE_MULTIPLE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF#
-#COMPENSATE#COMPENSATE_O = TauCompensate.o #ENDIF#
-#PTHREAD_AVAILABLE#THR_O = PthreadLayer.o #ENDIF#
-#TAU_PAPI_THREADS#THR_O = PapiThreadLayer.o #ENDIF#
-#TAU_SPROC#THR_O = SprocLayer.o #ENDIF#
-#JAVA#THR_O = JavaThreadLayer.o #ENDIF#
-#TULIPTHREADS#THR_O = TulipThreadLayer.o #ENDIF#
-#LINUXTIMERS#PLATFORM_O = TauLinuxTimers.o #ENDIF#
-#TULIPTHREADS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/Tuliplib #ENDIF#
-#SMARTS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/lib -I$(TULIPDIR)/machine-specific/$(HOSTTYPE) #ENDIF#
-#SMARTS#PROFILEOPT18 = -DSMARTS #ENDIF#
-#KAI#PROFILEOPT19 = -DKAI -DTAU_DOT_H_LESS_HEADERS #ENDIF#
-#USE_DECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF#
-#SGICC#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF#
-#USE_INTELCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF#
-#USE_NECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF#
-#PGI#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF#
-#ACC#PROFILEOPT19 = -AA +z -DTAU_DOT_H_LESS_HEADERS -DTAU_HPUX #ENDIF#
-#FUJITSU#PROFILEOPT19 = -DFUJITSU -DTAU_DOT_H_LESS_HEADERS #ENDIF#
-#KAINOEX#PROFILEOPT20 = --no_exceptions #ENDIF#
-#SGICCNOEX#PROFILEOPT20 = -LANG:exceptions=off #ENDIF#
-#HPGNU#PROFILEOPT21 = -fPIC #ENDIF#
-#HITACHI#PROFILEOPT21 = -DTAU_HITACHI #ENDIF#
-#SP1#PROFILEOPT21 = -D_POSIX_SOURCE -DTAU_AIX #ENDIF#
-#PPC64#TAU_PIC_PROFILEOPT21 = -qpic=large #ENDIF#
-#BGL#TAU_PIC_PROFILEOPT21 = #ENDIF#
-PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC $(TAU_PIC_PROFILEOPT21) #ENDIF##USE_IBMXLC#
-#IBMXLCAPPLE#PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC -DTAU_APPLE_XLC #ENDIF#
-#PCLPTHREAD#PROFILEOPT22 = -DPCL_MUTEX_LOCK #ENDIF#
-#JAVA#PROFILEOPT23 = -DJAVA #ENDIF#
-#MONITOR#PROFILEOPT24 = -DMONITORING_ON #ENDIF#
-#JAVA#PROFILEOPT25 = -I$(JDKDIR)/include -I$(JDKDIR)/include/$(JDKARCH) #ENDIF#
-PROFILEOPT26 = -DTAU_MPI #ENDIF##MPI#
-PROFILEOPT26 = -DTAU_MPI -DTAU_MPI_THREADED #ENDIF##MPI_THREADED#
-#OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP#ENDIF#
-#GNU#PROFILEOPT27 = #ENDIF#
-#SOL2CC_OPENMP#PROFILEOPT27 = -xopenmp -DTAU_OPENMP#ENDIF#
-#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF#
-#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF#
-#HITACHI_OPENMP#PROFILEOPT27 = -DTAU_OPENMP#ENDIF#
-#COMPAQCXX_OPENMP#PROFILEOPT27 = -omp -DTAU_OPENMP#ENDIF#
-#IBMXLC_OPENMP#PROFILEOPT27 = -qsmp=omp -DTAU_OPENMP #ENDIF#
-#OPEN64_OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP #ENDIF#
-#GUIDE#PROFILEOPT27 = -DTAU_OPENMP #ENDIF#
-#PGIOPENMP#PROFILEOPT27 = -mp -D_OPENMP -DTAU_OPENMP -U_RWSTD_MULTI_THREAD -U_REENTRANT #ENDIF#
-#INTELOPENMP#PROFILEOPT27 = -openmp -DTAU_OPENMP #ENDIF#
-#GNUOPENMP#PROFILEOPT27 = -fopenmp -DTAU_OPENMP #ENDIF#
-#OPARI#PROFILEOPT28 = -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF#
-#OPARI_REGION#PROFILEOPT28 = -DTAU_OPARI_REGION -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF#
-#OPARI_CONSTRUCT#PROFILEOPT28 = -DTAU_OPARI_CONSTRUCT -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF#
-#MULTIPLECOUNTERS#PROFILEOPT29 = -DTAU_MULTIPLE_COUNTERS #ENDIF#
-#SGITIMERS#PROFILEOPT30 = -DSGI_TIMERS #ENDIF#
-#BGLTIMERS#PROFILEOPT30 = -DBGL_TIMERS -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF#
-#BGPTIMERS#PROFILEOPT30 = -DBGP_TIMERS -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF#
-#CRAYTIMERS#PROFILEOPT30 = -DCRAY_TIMERS #ENDIF#
-#LINUXTIMERS#PROFILEOPT31 = -DTAU_LINUX_TIMERS #ENDIF#
-#ALPHATIMERS#PROFILEOPT31 = -DTAU_ALPHA_TIMERS #ENDIF#
-#CPUTIME#PROFILEOPT32 = -DCPU_TIME #ENDIF#
-#PAPIWALLCLOCK#PROFILEOPT33 = -DTAU_PAPI_WALLCLOCKTIME #ENDIF#
-#PAPIVIRTUAL#PROFILEOPT34 = -DTAU_PAPI_VIRTUAL #ENDIF#
-#SGICOUNTERS#PROFILEOPT35 = -DSGI_HW_COUNTERS #ENDIF#
-#EPILOG#PROFILEOPT36 = -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF#
-#SCALASCA#PROFILEOPT36 = -DTAU_SCALASCA -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF#
-#VAMPIRTRACEINTS#TAU_VAMPIRTRACEOPTS = -DTAU_64BITTYPES_NEEDED -DHAVE_INTTYPES_H #ENDIF#
-#VAMPIRTRACE#PROFILEOPT36 = -DTAU_VAMPIRTRACE -I$(VAMPIRTRACEDIR)/vtlib -I$(VAMPIRTRACEDIR)/include $(TAU_VAMPIRTRACEOPTS)#ENDIF#
-#PROFILECALLPATH#PROFILEOPT36 = -DTAU_CALLPATH #ENDIF#
-#PROFILEPHASE#PROFILEOPT36 = -DTAU_CALLPATH -DTAU_PROFILEPHASE#ENDIF#
-#PYTHON#PROFILEOPT37 = -I$(PYTHON_INCDIR) #ENDIF#
-#NOCOMM#PROFILEOPT38 = -DTAU_NOCOMM #ENDIF#
-#MUSE#PROFILEOPT39 = -DTAU_MUSE #ENDIF#
-#SETNODE0#PROFILEOPT40 = -DTAU_SETNODE0 #ENDIF#
-#COMPENSATE#PROFILEOPT41 = -DTAU_COMPENSATE #ENDIF#
-#MUSE_EVENT#PROFILEOPT42 = -DTAU_MUSE_EVENT #ENDIF#
-#MUSE_MULTIPLE#PROFILEOPT43 = -DTAU_MUSE_MULTIPLE #ENDIF#
-#DYNINST41##PROFILEOPT44 = -DTAU_DYNINST41BUGFIX #ENDIF#
-# DyninstAPI v4.2.1 fixes the bug, so we don't need OPT44 anymore
-#PROFILEMEMORY#PROFILEOPT45 = -DTAU_PROFILEMEMORY #ENDIF#
-PROFILEOPT46 = -DTAU_MPIGREQUEST #ENDIF##MPIGREQUEST#
-#MPIOREQUEST#PROFILEOPT47 = -DTAU_MPIOREQUEST #ENDIF#
-PROFILEOPT48 = -DTAU_MPIDATAREP #ENDIF##MPIDATAREP#
-PROFILEOPT49 = -DTAU_MPIERRHANDLER #ENDIF##MPIERRHANDLER#
-#CATAMOUNT#PROFILEOPT50 = -DTAU_CATAMOUNT #ENDIF#
-#MPICONSTCHAR#PROFILEOPT51 = -DTAU_MPICONSTCHAR #ENDIF#
-PROFILEOPT52 = -DTAU_MPIATTRFUNCTION #ENDIF##MPIATTR#
-PROFILEOPT53 = -DTAU_MPITYPEEX #ENDIF##MPITYPEEX#
-PROFILEOPT54 = -DTAU_MPIADDERROR #ENDIF##MPIADDERROR#
-#MPINEEDSTATUSCONV#PROFILEOPT55 = -DTAU_MPI_NEEDS_STATUS #ENDIF#
-
-#DEPTHLIMIT#PROFILEOPT56 = -DTAU_DEPTH_LIMIT #ENDIF#
-#TAU_CHARM#PROFILEOPT57 = -DTAU_CHARM -I$(CHARMDIR)/include #ENDIF#
-#PROFILEHEADROOM#PROFILEOPT58 = -DTAU_PROFILEHEADROOM #ENDIF#
-#JAVACPUTIME#PROFILEOPT59 = -DJAVA_CPU_TIME #ENDIF#
-PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE #ENDIF##TAU_LARGEFILE#
-PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE -D__xlc__ #ENDIF##BGP#
-# Omit the -D_LARGETFILE64_SOURCE till we can check the IBM crash
-#SHMEM#PROFILEOPT61 = -DTAU_SHMEM #ENDIF#
-#KTAU#PROFILEOPT62 = -DTAUKTAU -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -I$(KTAU_INCUSERDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF#
-#KTAU_MERGE#PROFILEOPT63 = -DTAUKTAU_MERGE -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF#
-#FREEBSD#PROFILEOPT64 = -DTAU_FREEBSD #ENDIF#
-#PROFILEPARAM#PROFILEOPT65 = -DTAU_PROFILEPARAM #ENDIF#
-#IBMMPI#PROFILEOPT66 = -DTAU_IBM_MPI #ENDIF#
-#WEAKMPIINIT#PROFILEOPT67 = -DTAU_WEAK_MPI_INIT #ENDIF#
-#LAMPI#PROFILEOPT68 = -DTAU_LAMPI #ENDIF#
-#MPICH_IGNORE_CXX_SEEK#PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF#
-PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF##BGP#
-#MPICH2_MPI_INPLACE#PROFILEOPT73 = -DTAU_MPICH2_MPI_IN_PLACE #ENDIF#
-
-
-############# RENCI Scalable Trace Lib Options #############
-STFF_DIR=
-SDDF_DIR=
-#RENCI_STFF#PROFILEOPT69 = -DRENCI_STFF -I$(STFF_DIR)/include #ENDIF#
-#RENCI_STFF#TAU_LINKER_OPT11 = -L$(STFF_DIR)/lib -lstff -L$(SDDF_DIR)/lib -lPablo $(TAU_MPI_LIB) #ENDIF#
-#RENCI_STFF#RENCI_STFF_O = RenciSTFF.o #ENDIF#
-
-############# KTAU (again) #############
-#KTAU_SHCTR#PROFILEOPT70 = -DTAUKTAU_SHCTR -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF#
-#KTAU#TAU_LINKER_OPT12 = -L$(KTAU_LIB) -lktau #ENDIF#
-
-#MIPS32LINUX#PROFILEOPT71 = -D_ABIN32=2 -D_MIPS_SIM=_ABIN32 #ENDIF#
-
-#BGL#PROFILEOPT72 = -DTAU_BGL -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF#
-PROFILEOPT72 = -DTAU_BGP -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF##BGP#
-
-#For F90 support for all platforms
-FWRAPPER = TauFMpi.o
-MPI2EXTENSIONS = TauMpiExtensions.o #ENDIF##MPI2#
-MPI2EXTENSIONS = #ENDIF##BGP#
-#CRAYX1CC#MPI2EXTENSIONS = #ENDIF#
-
-#SGICOUNTERS#LEXTRA = -lperfex #ENDIF#
-#ALPHATIMERS#LEXTRA = -lrt #ENDIF#
-#SOL2#PCL_EXTRA_LIBS = -lcpc #ENDIF#
-#PCL#LEXTRA = -L$(PCLDIR)/lib -lpcl $(PCL_EXTRA_LIBS) #ENDIF#
-#PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF#
-#IA64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF#
-#Due to some problems with older versions of libpfm, we are using the static lib
-#IA64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF#
-#PAPIPFM##LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpfm -lpapi -lpfm #ENDIF#
-#X86_64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR)/ -L$(PAPIDIR)/lib64/ -lpapi -lperfctr #ENDIF#
-#SOL2PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -lcpc #ENDIF#
-#IBMPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi#ENDIF#
-#PPC64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF#
-#BGLPAPI_RTS#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.rts.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF#
-#BGLPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF#
-#BGPPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgsys/drivers/ppcfloor/runtime/SPI -lSPI.cna #ENDIF#
-#IBM64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi64.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi #ENDIF#
-#IBM64PAPILINUX#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF#
-#SGI64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi64 #ENDIF#
-#ALPHAPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a /usr/lib/dcpi/dadd.a -lclu -lrt #ENDIF#
-
-TAU_PAPI_EXTRA_FLAGS = $(LEXTRA)
-#IA64PAPI#TAU_PAPI_EXTRA_FLAGS = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF#
-
-
-# By default make TAU_PAPI_RPATH null. Support it on a compiler by compiler basis.
-#PAPI###TAU_PAPI_RPATH = -rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF#
-#PAPI##TAU_PAPI_RPATH = #ENDIF#
-#PPC64PAPI#TAU_PAPI_RPATH = #ENDIF#
-#BGLPAPI#TAU_PAPI_RPATH = #ENDIF#
-#BGPPAPI#TAU_PAPI_RPATH = #ENDIF#
-#USE_INTELCXX#TAU_PAPI_RPATH = #ENDIF#
-#CRAYX1CC#TAU_PAPI_RPATH = #ENDIF#
-#PGI#TAU_PAPI_RPATH = -R$(PAPIDIR)/$(PAPISUBDIR) #ENDIF#
-#GNU#TAU_PAPI_RPATH = -Wl,-rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF#
-#USE_PATHCC#TAU_PAPI_RPATH = #ENDIF#
-
-# if the user has specified -cc=gcc -c++=g++ -fortran=intel, we shouldn't use -rpath
-# because they are likely going to link with ifort
-#INTEL32_FORTRAN#TAU_PAPI_RPATH = #ENDIF#
-#SOL2PAPI#TAU_PAPI_RPATH = #ENDIF#
-#IBMPAPI#TAU_PAPI_RPATH = #ENDIF#
-#IBM64PAPI#TAU_PAPI_RPATH = #ENDIF#
-#PAPI#TAU_LINKER_OPT1 = $(TAU_PAPI_RPATH) #ENDIF#
-
-#PTHREAD_AVAILABLE#LEXTRA1 = -lpthread #ENDIF#
-#TULIPTHREADS#LEXTRA1 = -L$(TULIPDIR)/Tuliplib -ltulip #ENDIF#
-#SMARTS##include $(TAU_INC_DIR)/makefiles/GNUmakefile-$(HOSTTYPE) #ENDIF#
-#SMARTS#LEXTRA1 = $(LSMARTS) #ENDIF#
-
-TAU_GCCLIB = -lgcc_s
-TAU_GCCLIB = #ENDIF##BGP#
-#INTEL32_ON_64#TAU_GCCLIB = -lgcc #ENDIF#
-#FREEBSD#TAU_GCCLIB = -lgcc #ENDIF#
-#BGL#TAU_GCCLIB = -lgcc #ENDIF#
-#GNU#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF#
-#OPEN64ORC_FORTRAN#TAU_FORTRANLIBS = -lfortran -lffio #ENDIF#
-#PATHSCALE_FORTRAN#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF#
-#SC_PATHSCALE#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF#
-#NAGWARE_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/quickfit.o -L$(EXTRADIR)/lib -lf96 #ENDIF#
-#G95_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR) -lf95 #ENDIF#
-#GNU_FORTRAN#TAU_FORTRANLIBS = -lg2c #ENDIF#
-#GNU_GFORTRAN#TAU_FORTRANLIBS = -L$(TAUGFORTRANLIBDIR) -lgfortran -lgfortranbegin #ENDIF#
-#SC_GFORTRAN#TAU_FORTRANLIBS = -lgfortran -lgfortranbegin #ENDIF#
-#SGI_FORTRAN#TAU_FORTRANLIBS = -lfortran -lftn #ENDIF#
-TAU_IBM_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC#
-#GNU#TAU_IBM_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF#
-#KAI#TAU_IBM_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF#
-TAU_FORTRANLIBS = $(TAU_IBM_FORTRANLIBS) #ENDIF##IBM_FORTRAN#
-
-TAU_IBM64_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC#
-#GNU#TAU_IBM64_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 -Wl,-b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF#
-#KAI#TAU_IBM64_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 --backend -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF#
-#IBM64_FORTRAN#TAU_FORTRANLIBS = $(TAU_IBM64_FORTRANLIBS) #ENDIF#
-#IBM64_FORTRAN#TAU_FORLIBDIR=lib64 #ENDIF#
-TAU_FORLIBDIR=lib #ENDIF##IBM_FORTRAN#
-#BGL#TAU_FORLIBDIR=blrts_dev_lib #ENDIF#
-TAU_FORLIBDIR=bglib #ENDIF##BGP#
-#PPC64#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath -lxl #ENDIF#
-#BGL#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -L$(EXTRADIR)/blrts_lib -lxlf90 -lxlfmath -lxl #ENDIF#
-
-TAU_BGL_OMP_SERIAL= -lxlomp_ser #ENDIF##BGP#
-#OPENMP#TAU_BGL_OMP_SERIAL= #ENDIF#
-TAU_OMP_SERIAL=$(TAU_BGL_OMP_SERIAL) #ENDIF##BGP#
-TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath $(TAU_OMP_SERIAL) #ENDIF##BGP#
-
-#IBMXLFAPPLE#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lxlf90 -lxlfmath -lxl #ENDIF#
-
-#CRAY_FORTRAN#TAU_FORTRANLIBS = #ENDIF#
-#CRAY_X1_FORTRAN#TAU_FORTRANLIBS = #ENDIF#
-#PGI_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/f90main.o -lpgf90 -lpgf90rtl -lpgf90_rpm1 -lpgf902 -lpgftnrtl -lrt #ENDIF#
-#HP_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib/pa2.0 -lF90 -lcl #ENDIF#
-#INTEL_FORTRAN#TAU_FORTRANLIBS = -lcprts -lPEPCF90 #ENDIF#
-#INTEL32_FORTRAN#TAU_FORTRANLIBS = -lcprts -lCEPCF90 -lF90 #ENDIF#
-#INTELIFORT#TAU_FORTRANLIBS = -lcprts #ENDIF#
-#INTEL81FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF#
-#INTEL10FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF#
-#INTELCXXLIBICC#TAU_FORTRANLIBS = -lcprts -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF#
-#PGI1.7#LEXTRA = -lstd -lstrm#ENDIF#
-#PGI1.7#TAUHELPER = $(TAUROOT)/src/Profile/TauPGIHelper.cpp #ENDIF#
-# LINKER OPTIONS
-TAU_LINKER_OPT2 = $(LEXTRA)
-
-
-#ACC#TAUHELPER = -AA #ENDIF#
-#FUJITSU_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 #ENDIF#
-#FUJITSU_SOLARIS#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj90l -lfj90f #ENDIF#
-#SUN_FORTRAN#TAU_FORTRANLIBS = -lfui -lfsumai -lfprodai -lfminlai -lfmaxlai -lfminvai -lfmaxvai -lfsu -lsunmath #ENDIF#
-#SUN_FORTRAN#TAU_FORTRANLIBS_SUN_OPTERON = -lfsu -lsunmath #ENDIF#
-#SUN_FORTRAN#TAU_FORTRANLIBS_SUNCC = -lfsu #ENDIF#
-#SUN386I#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF#
-#SUNX86_64#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF#
-#SUNCC#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUNCC) #ENDIF#
-#SOL2#EXTRALIBS = -lsocket -lnsl #ENDIF#
-#SUN386I#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF#
-#SUNX86_64#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF#
-#COMPAQ_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -L$(EXTRADIR)/lib -L$(EXTRADIR)/lib/cmplrs/fort90 -L$(EXTRADIR)/lib/cmplrs/fort90 -lUfor -lfor -lFutil -lm -lmld -lexc -lc #ENDIF#
-#ABSOFT_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lfio -lf90math -lU77 -lf77math -lfio #ENDIF#
-#LAHEY_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 -lfccx86_6a #ENDIF#
-#LAHEY64_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib64/fj90rt0.o -L$(EXTRADIR)/lib64 -lfj90f -lfj90i -lelf #ENDIF#
-#HITACHI_FORTRAN#TAU_FORTRANLIBS = -lf90 -lhf90math #ENDIF#
-#NEC_FORTRAN#TAU_FORTRANLIBS = -f90lib #ENDIF#
-#COMPAQ_GUIDEF90#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -lfor #ENDIF#
-
-
-#HITACHI#TAU_HITACHI_EXTRA = -L/usr/local/lib -llrz32 #ENDIF#
-
-## To use the standard F90 linker instead of TAU_LINKER + TAU_FORTRANLIBS, add
-#GNU#TAU_CXXLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF#
-#GNU#TAU_GNUCXXLIBS = -L$(TAUGCCLIBDIR) -lstdc++ $(TAU_GCCLIB) #ENDIF#
-#OPEN64ORC#TAU_CXXLIBS = -lstdc++ #ENDIF#
-#PATHSCALE_FORTRAN#TAU_CXXLIBS = -lstdc++ #ENDIF#
-#LAHEY_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF#
-#NAGWARE_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF#
-#PGI#TAU_CXXLIBS = -lstd -lC #ENDIF#
-#CRAYCNL#TAU_CXXLIBS = -L$(EXTRADIR)/lib -lstd -lC -lpgc #ENDIF#
-#CRAYX1CC#TAU_CXXLIBS = -L/opt/ctl/CC/CC/lib -lC #ENDIF#
-
-TAU_SGI_INIT = /usr/lib32/c++init.o
-#ENABLE64BIT#TAU_SGI_INIT = /usr/lib64/c++init.o #ENDIF#
-#ENABLEN32BIT#TAU_SGI_INIT = /usr/lib32/c++init.o #ENDIF#
-#ENABLE32BIT#TAU_SGI_INIT = /usr/lib/c++init.o #ENDIF#
-
-#SGICC#TAU_CXXLIBS = $(TAU_SGI_INIT) -lC #ENDIF#
-#APPLECXX#TAU_CXXLIBS = -lstd -lC #ENDIF#
-#SOL2#TAU_CXXLIBS = -lCstd -lCrun #ENDIF#
-#SOL2CC#TAU_CXXLIBS_SUN_OPTERON = -lCstd -lCrun -lm #ENDIF#
-#SUNCC#TAU_CXXLIBS_SUNCC = -lCstd -lCrun #ENDIF#
-#SUN386I#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF#
-#SUNCC#TAU_CXXLIBS = $(TAU_CXXLIBS_SUNCC) #ENDIF#
-#SUNX86_64#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF#
-#FUJITSU_SOLARIS#TAU_CXXLIBS = -lstd -lstdm #ENDIF#
-#PPC64#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF#
-#IBMXLCAPPLE#TAU_FORLIBDIR =lib #ENDIF#
-#IBMXLCAPPLE#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF#
-#BGL#TAU_XLCLIBS = -L$(EXTRADIRCXX)/blrts_dev_lib -L$(EXTRADIRCXX)/blrts_lib -libmc++ -L/bgl/BlueLight/ppcfloor/blrts-gnu/powerpc-bgl-blrts-gnu/lib -lstdc++ #ENDIF#
-TAU_XLCLIBS = -L$(EXTRADIRCXX)/bglib -libmc++ -lstdc++ #ENDIF##BGP#
-#SP1#TAU_XLCLIBS = -lC #ENDIF#
-TAU_CXXLIBS = $(TAU_XLCLIBS) #ENDIF##USE_IBMXLC#
-#USE_DECCXX#TAU_CXXLIBS = -lcxxstd -lcxx #ENDIF#
-#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts -lPEPCF90 #ENDIF#
-#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts #ENDIF#
-#INTELIFORT#TAU_CXXLIBS_INTEL = -lcprts #ENDIF#
-#INTEL81FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind#ENDIF#
-#INTEL10FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF#
-#INTELCXXLIBICC#TAU_CXXLIBS_INTEL = -lcprts #ENDIF#
-#USE_INTELCXX#TAU_CXXLIBS = $(TAU_CXXLIBS_INTEL) #ENDIF#
-#APPLECXX#TAU_CXXLIBS = -lstdc++ -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lgcc_s.1 -lSystemStubs #ENDIF#
-
-# EXTERNAL PACKAGES: VAMPIRTRACE
-#VAMPIRTRACE#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF#
-#VAMPIRTRACEMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.mpi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF#
-#VAMPIRTRACEOMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.ompi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF#
-#VAMPIRTRACEOMP#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.omp -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF#
-
-# EXTERNAL PACKAGES: EPILOG
-#SCALASCA#TAU_ELG_SERIAL_SUFFIX =.ser #ENDIF#
-#EPILOG#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg$(TAU_ELG_SERIAL_SUFFIX) $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF#
-#EPILOGMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.mpi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF#
-#EPILOGOMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.ompi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF#
-#EPILOGOMP#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.omp $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF#
-
-# When using shared, we don't want -lelg.mpi or -lvt.mpi showing up
-#FORCESHARED#TAU_LINKER_OPT3=#ENDIF#
-
-TAU_LINKER_OPT4 = $(LEXTRA1)
-#HITACHI_OPENMP#TAU_LINKER_OPT4 = -lcompas -lpthreads -lc_r #ENDIF#
-#OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF#
-#SOL2CC_OPENMP#TAU_LINKER_OPT5 = -xopenmp #ENDIF#
-#SUNCC_OPENMP#TAU_LINKER_OPT5 = -xopenmp=parallel #ENDIF#
-#GNU#TAU_LINKER_OPT5 = #ENDIF#
-#COMPAQCXX_OPENMP#TAU_LINKER_OPT5 = -omp #ENDIF#
-#IBMXLC_OPENMP#TAU_LINKER_OPT5 = -qsmp=omp #ENDIF#
-#OPEN64_OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF#
-#GUIDE#TAU_LINKER_OPT5 = #ENDIF#
-#PGIOPENMP#TAU_LINKER_OPT5 = -mp #ENDIF#
-#INTELOPENMP#TAU_LINKER_OPT5 = -openmp #ENDIF#
-
-# MALLINFO needs -lmalloc on sgi, sun
-#SGIMP#TAU_LINKER_OPT6 = -lmalloc #ENDIF#
-#SOL2#TAU_LINKER_OPT6 = #ENDIF#
-#SUN386I#TAU_LINKER_OPT6 = -lmalloc #ENDIF#
-#SUNX86_64#TAU_LINKER_OPT6 = -lmalloc #ENDIF#
-
-# We need -lCio with SGI CC 7.4+
-#SGICC#TAU_LINKER_OPT7 = -lCio #ENDIF#
-
-# charm
-#TAU_CHARM#TAU_LINKER_OPT8 = -lconv-core #ENDIF#
-
-# extra libs
-#SUN386I#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF#
-#SUNX86_64#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF#
-#SOL2#TAU_LINKER_OPT9 = $(ExTRALIBS) #ENDIF#
-
-#BGL#TAU_LINKER_OPT10 = -L/bgl/BlueLight/ppcfloor/bglsys/lib -lrts.rts #ENDIF#
-
-TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF##USE_IBMXLC#
-#GNU#TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF#
-#KAI#TAU_IBM_PYTHON_SHFLAG = --backend -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp --backend -Wl,-einitpytau#ENDIF#
-#ACC#TAU_HPUX_PYTHON_SHFLAG = -lstd_v2 -lCsup_v2 -lm -lcl -lc #ENDIF#
-
-TAU_IBM_LD_FLAGS = -binitfini:poe_remote_main #ENDIF##USE_IBMXLC#
-#GNU#TAU_IBM_LD_FLAGS = -Wl,-binitfini:poe_remote_main #ENDIF#
-#KAI#TAU_IBM_LD_FLAGS = --backend -binitfini:poe_remote_main #ENDIF#
-
-
-#PYTHON#TAU_IBM_SHFLAGS = $(TAU_IBM_PYTHON_SHFLAG) #ENDIF#
-#PYTHON#TAU_HPUX_SHFLAGS = $(TAU_HPUX_PYTHON_SHFLAG) #ENDIF#
-#SP1#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_IBM_SHFLAGS) #ENDIF#
-#SOL2#TAU_EXTRA_LIBRARY_FLAGS = #ENDIF#
-#SGIMP#TAU_EXTRA_LIBRARY_FLAGS = -lmalloc #ENDIF#
-#HP#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_HPUX_SHFLAGS) #ENDIF#
-
-TAU_MPI_WRAPPER_LIB= -L$(TAU_LIB_DIR) -lTauMpi$(TAU_CONFIG) #ENDIF##MPI#
-#EPILOGMPI#TAU_MPI_WRAPPER_LIB= #ENDIF#
-#EPILOGOMPI#TAU_MPI_WRAPPER_LIB= #ENDIF#
-
-##############################################
-# Build TAU_LINKER_SHOPTS
-#GNU#TAU_IBM_LINKER_SHOPTS=-Wl,-brtl -Wl,-bexpall #ENDIF#
-TAU_IBM_LINKER_SHOPTS= -brtl -bexpall #ENDIF##USE_IBMXLC#
-#KAI#TAU_IBM_LINKER_SHOPTS= --backend -brtl #ENDIF#
-#SP1#TAU_LINKER_SHOPTS= $(TAU_IBM_LINKER_SHOPTS) #ENDIF#
-
-##############################################
-# MPI _r suffix check (as in libmpi_r)
-#MPI_R_SUFFIX#TAU_MPI_R_SUFFIX=_r #ENDIF#
-
-##############################################
-# Flags to build a shared object: TAU_SHFLAGS
-#GNU#AR_SHFLAGS = -shared #ENDIF#
-#PGI#AR_SHFLAGS = -shared #ENDIF#
-#SGICC#AR_SHFLAGS = -shared #ENDIF#
-#APPLECXX#AR_SHFLAGS = -dynamiclib -flat_namespace -undefined suppress #ENDIF#
-#SOL2#AR_SHFLAGS = -G #ENDIF#
-#SUN386I#AR_SHFLAGS = -G #ENDIF#
-#SUNX86_64#AR_SHFLAGS = -G #ENDIF#
-AR_SHFLAGS = -G #ENDIF##USE_IBMXLC#
-#USE_DECCXX#AR_SHFLAGS = -shared #ENDIF#
-#USE_INTELCXX#AR_SHFLAGS = -shared #ENDIF#
-#ACC#AR_SHFLAGS = -b #ENDIF#
-TAU_SHFLAGS = $(AR_SHFLAGS) -o
-
-############# RANLIB Options #############
-TAU_RANLIB = echo "Built"
-#APPLECXX#TAU_RANLIB = ranlib #ENDIF#
-#IBMXLCAPPLE#TAU_RANLIB = ranlib #ENDIF#
-
-##############################################
-TAU_AR = ar #ENDIF#
-#SP1#TAU_AR = ar -X32 #ENDIF#
-#IBM64#TAU_AR = ar -X64 #ENDIF#
-#PPC64#TAU_AR = ar #ENDIF#
-#IBM64LINUX#TAU_AR = ar #ENDIF#
-
-
-##############################################
-# PDT OPTIONS
-# You can specify -pdtcompdir=intel -pdtarchdir=x86_64
-# If nothing is specified, PDTARCHDIR uses TAU_ARCH
-PDTARCHDIRORIG=$(TAU_ARCH)
-PDTARCHITECTURE=x86_64
-PDTARCHDIRFINAL=$(PDTARCHDIRORIG)
-#PDTARCHITECTURE#PDTARCHDIRFINAL=$(PDTARCHITECTURE)#ENDIF#
-PDTARCHDIR=$(PDTARCHDIRFINAL)
-#PDTARCH#PDTARCHDIR=$(PDTARCHDIRFINAL)/$(PDTCOMPDIR)#ENDIF#
-
-
-##############################################
-
-PROFILEOPTS = $(PROFILEOPT1) $(PROFILEOPT2) $(PROFILEOPT3) $(PROFILEOPT4) \
- $(PROFILEOPT5) $(PROFILEOPT6) $(PROFILEOPT7) $(PROFILEOPT8) \
- $(PROFILEOPT9) $(PROFILEOPT10) $(PROFILEOPT11) $(PROFILEOPT12) \
- $(PROFILEOPT13) $(PROFILEOPT14) $(PROFILEOPT15) $(PROFILEOPT16) \
- $(PROFILEOPT17) $(PROFILEOPT18) $(PROFILEOPT19) $(PROFILEOPT20) \
- $(PROFILEOPT21) $(PROFILEOPT22) $(PROFILEOPT23) $(PROFILEOPT24) \
- $(PROFILEOPT25) $(PROFILEOPT26) $(PROFILEOPT27) $(PROFILEOPT28) \
- $(PROFILEOPT29) $(PROFILEOPT30) $(PROFILEOPT31) $(PROFILEOPT32) \
- $(PROFILEOPT33) $(PROFILEOPT34) $(PROFILEOPT35) $(PROFILEOPT36) \
- $(PROFILEOPT37) $(PROFILEOPT38) $(PROFILEOPT39) $(PROFILEOPT40) \
- $(PROFILEOPT41) $(PROFILEOPT42) $(PROFILEOPT43) $(PROFILEOPT44) \
- $(PROFILEOPT45) $(PROFILEOPT46) $(PROFILEOPT47) $(PROFILEOPT48) \
- $(PROFILEOPT49) $(PROFILEOPT50) $(PROFILEOPT51) $(PROFILEOPT52) \
- $(PROFILEOPT53) $(PROFILEOPT54) $(PROFILEOPT55) $(PROFILEOPT56) \
- $(PROFILEOPT57) $(PROFILEOPT58) $(PROFILEOPT59) $(PROFILEOPT60) \
- $(PROFILEOPT61) $(PROFILEOPT62) $(PROFILEOPT63) $(PROFILEOPT64) \
- $(PROFILEOPT65) $(PROFILEOPT66) $(PROFILEOPT67) $(PROFILEOPT68) \
- $(PROFILEOPT69) $(PROFILEOPT70) $(PROFILEOPT71) $(PROFILEOPT72) \
- $(PROFILEOPT73) $(PROFILEOPT74) $(PROFILEOPT75) $(PROFILEOPT76) \
- $(TRACEOPT)
-
-##############################################
-
-TAU_LINKER_OPTS = $(TAU_LINKER_OPT1) $(TAU_LINKER_OPT2) $(TAU_LINKER_OPT3) \
- $(TAU_LINKER_OPT4) $(TAU_LINKER_OPT5) $(TAU_LINKER_OPT6) \
- $(TAU_LINKER_OPT7) $(TAU_LINKER_OPT8) $(TAU_LINKER_OPT9) \
- $(TAU_LINKER_OPT10) $(TAU_LINKER_OPT11) $(TAU_LINKER_OPT12)
-
-##############################################
-
-############# TAU Fortran ####################
-TAU_LINKER=$(TAU_CXX)
-#INTEL_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF#
-#INTEL32_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF#
-# Intel efc compiler acts as a linker - NO. Let C++ be the linker.
-
-##############################################
-############# TAU Options ####################
-TAUDEFS = $(PROFILEOPTS)
-
-TAUINC = -I$(TAU_INC_DIR)
-
-TAULIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS)
-
-TAUMPILIBS = $(TAU_MPI_LIB)
-
-TAUMPIFLIBS = $(TAU_MPI_FLIB)
-
-### ACL S/W requirement
-TAU_DEFS = $(TAUDEFS)
-
-TAU_INCLUDE = -I$(TAU_INC_DIR)
-#PERFLIB#TAU_INCLUDE = -I$(PERFINCDIR) #ENDIF#
-#PERFLIB#TAU_DEFS = #ENDIF#
-#PERFLIB#TAU_COMPILER_EXTRA_OPTIONS=-optTau=-p #ENDIF#
-
-TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/Memory
-#IBMXLCAPPLE#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF#
-#APPLECXX#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF#
-
-TAU_LIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS)
-#PERFLIB#TAU_LIBS = #ENDIF#
-
-TAU_SHLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB)
-#PERFLIB#TAU_SHLIBS = #ENDIF#
-TAU_EXLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB)
-
-TAU_SHLIBS_NOSHOPTS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS)
-
-TAU_DISABLE = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTauDisable
-
-TAU_MPI_INCLUDE = $(TAU_MPI_INC)
-
-TAU_MPI_LIBS = $(TAU_MPI_LIB)
-
-TAU_MPI_FLIBS = $(TAU_MPI_FLIB)
-
-## TAU TRACE INPUT LIBRARY (can build a trace converter using TAU TIL)
-TAU_TRACE_INPUT_LIB = -L$(TAU_LIB_DIR) -lTAU_traceinput$(TAU_CONFIG)
-
-## Don't include -lpthread or -lsmarts. Let app. do that.
-#############################################
-## IBM SPECIFIC CHANGES TO TAU_MPI_LIBS
-#SP1#TAU_MPI_LDFLAGS = $(TAU_IBM_LD_FLAGS) #ENDIF#
-TAU_LDFLAGS = $(TAU_MPI_LDFLAGS) #ENDIF##MPI#
-#SP1#TAU_IBM_MPI_LIBS = $(TAU_MPI_LIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF#
-#SP1#TAU_IBM_FMPI_LIBS = $(TAU_MPI_FLIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF#
-#SP1#TAU_MPI_LIBS_FLAGS= $(TAU_IBM_MPI_LIBS) #ENDIF#
-#SP1#TAU_MPI_FLIBS_FLAGS = $(TAU_IBM_MPI_FLIBS) #ENDIF#
-TAU_MPI_LIBS_FLAGS = $(TAU_MPI_LIB) #ENDIF##MPI#
-TAU_MPI_FLIBS_FLAGS = $(TAU_MPI_FLIB) #ENDIF##MPI#
-TAU_MPI_LIBS = $(TAU_MPI_LIBS_FLAGS) #ENDIF##MPI#
-TAU_MPI_FLIBS = $(TAU_MPI_FLIBS_FLAGS) #ENDIF##MPI#
-
-#SP1#TAUMPILIBS = $(TAU_MPI_LIBS) #ENDIF#
-#SP1#TAUMPIFLIBS = $(TAU_MPI_FLIBS) #ENDIF#
-#############################################
-#SHMEM#TAU_SHMEM_OBJS = TauShmemCray.o #ENDIF#
-#SP1#TAU_SHMEM_OBJS = TauShmemTurbo.o #ENDIF#
-#GPSHMEM#TAU_SHMEM_OBJS = TauShmemGpshmem.o #ENDIF#
-
-TAU_SHMEM_INCLUDE = $(TAU_SHMEM_INC)
-
-TAU_SHMEM_LIBS = -L$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/ -lTauShmem$(TAU_CONFIG) $(TAU_SHMEM_LIB)
-#############################################
-# TAU COMPILER SHELL SCRIPT OPTIONS
-TAUCOMPILEROPTS= -optPdtDir="$(PDTDIR)/${PDTARCHDIR}"\
- -optPdtCOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\
- -optPdtCxxOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\
- -optTauInstr="$(TAU_BIN_DIR)/tau_instrumentor" \
- -optNoMpi \
- -optOpariDir="$(OPARIDIR)" -optOpariTool="$(TAU_OPARI_TOOL)" \
- -optTauCC="$(TAU_CC)" \
- -optTauIncludes="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE)" \
- -optTauDefs="$(TAU_DEFS)" \
- -optTauCompile="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE) $(TAU_DEFS) "\
- -optLinking="$(TAU_MPI_FLIBS) $(TAU_LIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\
- -optSharedLinking="$(TAU_MPI_FLIBS) $(TAU_EXLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\
- $(TAU_COMPILER_EXTRA_OPTIONS) \
- -optIncludeMemory="$(TAU_INCLUDE_MEMORY)"
-#############################################
-
-TAU_SHAREDLIBS=$(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS)
-SHAREDEXTRAS=
-#FORCESHARED#SHAREDEXTRAS=-optSharedLinkReset="$(TAU_SHAREDLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS) $(TAU_MPI_NOWRAP_FLIB)" -optShared #ENDIF#
-TAU_COMPILER=$(TAU_BIN_DIR)/tau_compiler.sh $(TAUCOMPILEROPTS) $(SHAREDEXTRAS)
-#############################################
-# These options could be included in the application Makefile as
-#CFLAGS = $(TAUDEFS) $(TAUINC)
-#
-#LIBS = $(TAULIBS)
-#
-# To run the application without Profiling/Tracing use
-#CFLAGS = $(TAUINC)
-# Don't use TAUDEFS but do include TAUINC
-# Also ignore TAULIBS when Profiling/Tracing is not used.
-#############################################
-
+++ /dev/null
-###################################################################
-INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh
-
-
-FC= ifort
-
-OPT = -O3 -ip
-
-FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
-FFLAGS1 = -c -g -CA -CB -I$(INSTALL_DIR)/include
-FFLAGS2 = -c -g -O0 -I$(INSTALL_DIR)/include
-FFLAGSE = -c -O3 -ipo -opt_report -I$(INSTALL_DIR)/include
-
-
-LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-
-all: no_option
- @echo "give optin GAB or E0LL2Y"
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \
- energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- MP.o compare_s1.o prng.o \
- banach.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o test.o ssMD.o
-
-no_option:
-
-GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \
- -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC
-GAB: BIN = ../../../bin/unres/MD/unres_ifort_MPICH_GAB-restraint.exe
-GAB: ${object} xdrf/libxdrf.a
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
-
-E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \
- -DSPLITELE -DLANG0
-E0LL2Y: BIN = ../../../bin/unres/MD/unres_ifort_MPICH_E0LL2Y-restraint.exe
-E0LL2Y: ${object} xdrf/libxdrf.a
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
-
-xdrf/libxdrf.a:
- cd xdrf && make
-
-
-clean:
- /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean
-
-test.o: test.F
- ${FC} ${FFLAGS} ${CPPFLAGS} test.F
-
-chainbuild.o: chainbuild.F
- ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
-
-matmult.o: matmult.f
- ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
-
-parmread.o : parmread.F
- ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
-
-intcor.o : intcor.f
- ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
-
-cartder.o : cartder.F
- ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
-
-readpdb.o : readpdb.F
- ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F
-
-sumsld.o : sumsld.f
- ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
-
-cored.o : cored.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f
-
-rmdd.o : rmdd.f
- ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f
-
-energy_p_new_barrier.o : energy_p_new_barrier.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F
-
-gradient_p.o : gradient_p.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F
-
-energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F
-
-lagrangian_lesyng.o : lagrangian_lesyng.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F
-
-MD_A-MTS.o : MD_A-MTS.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F
-
-blas.o : blas.f
- ${FC} ${FFLAGS1} blas.f
-
-add.o : add.f
- ${FC} ${FFLAGS1} add.f
-
-eigen.o : eigen.f
- ${FC} ${FFLAGS2} eigen.f
-
-proc_proc.o: proc_proc.c
- ${CC} ${CFLAGS} proc_proc.c
+++ /dev/null
-CPPFLAGS = -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DSPLITELE -WF,-DISNAN -WF,-DAIX
-#-DPROCOR
-## -DMOMENT
-#-DCO_BIAS
-#-DCRYST_TOR
-#-DDEBUG
-
-INSTALL_DIR =
-#
-FC= mpxlf90 -qfixed -w
-
-OPT = -q64
-
-FFLAGS = -c ${OPT} -O3
-FFLAGS1 = -c ${OPT} -O2
-FFLAGS2 = -c ${OPT} -O
-FFLAGSE = -c ${OPT} -O4
-
-
-BIN = ${HOME}/UNRES/bin/unres_MD.exe
-LIBS = -qipa
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-all: unresCSA
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \
- energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \
- indexx.o MP.o compare_s1.o prng_32.o \
- test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o
-
-
-unresCSA: ${objectCSA}
- cc -o compinfo compinfo.c
- ./compinfo
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN}
-
-
-clean:
- /bin/rm *.o
- /bin/rm *.il
-
-newconf.o: newconf.f
- ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f
-
-bank.o: bank.F
- ${FC} ${FFLAGS} ${CPPFLAGS} bank.F
-
-diff12.o: diff12.f
- ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f
-
-csa.o: csa.f
- ${FC} ${FFLAGS} ${CPPFLAGS} csa.f
-
-shift.o: shift.F
- ${FC} ${FFLAGS} ${CPPFLAGS} shift.F
-
-ran.o: ran.f
- ${FC} ${FFLAGS} ${CPPFLAGS} ran.f
-
-together.o: together.F
- ${FC} ${FFLAGS} ${CPPFLAGS} together.F
-
-test.o: test.F
- ${FC} ${FFLAGS} ${CPPFLAGS} test.F
-
-chainbuild.o: chainbuild.F
- ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
-
-matmult.o: matmult.f
- ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
-
-parmread.o : parmread.F
- ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
-
-intcor.o : intcor.f
- ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
-
-cartder.o : cartder.F
- ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
-
-readpdb.o : readpdb.f
- ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f
-
-sumsld.o : sumsld.f
- ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
-
-cored.o : cored.f
- ${FC} ${FFLAGS} ${CPPFLAGS} cored.f
-
-rmdd.o : rmdd.f
- ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f
-
-energy_p_new.o : energy_p_new.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F
+++ /dev/null
-#
-FC= ftn
-OPT = -fast \
--Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \
--Mprefetch=distance:8,nta
-
-#OPT = -C -g
-#OPT1 = -g -fast
-OPT1 = ${OPT}
-OPT2 = -fast
-OPT2 = ${OPT}
-OPTE = ${OPT}
-
-FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
-FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include
-FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include
-FFLAGSE = ${FFLAGS}
-
-CFLAGS = -DSGI -c
-
-BIN = ../bin/unres_MD_Tc_procor-newmat-novec-noparint_barrier_corr-split.exe
-LIBS = xdrf/libxdrf.a
-
-CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \
- -DSPLITELE -DPROCOR -DAMD64 -DLANG0 \
-#-DTIMING \
-# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC
-#-DPARVEC #-DPARINT -DPARINTDER
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-
-all: unres
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \
- energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \
- indexx.o MP.o compare_s1.o prng.o \
- test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o
-
-unres: ${object} proc_proc.o
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN}
-
-
-clean:
- /bin/rm *.o
-
-newconf.o: newconf.f
- ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f
-
-bank.o: bank.F
- ${FC} ${FFLAGS} ${CPPFLAGS} bank.F
-
-diff12.o: diff12.f
- ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f
-
-csa.o: csa.f
- ${FC} ${FFLAGS} ${CPPFLAGS} csa.f
-
-shift.o: shift.F
- ${FC} ${FFLAGS} ${CPPFLAGS} shift.F
-
-ran.o: ran.f
- ${FC} ${FFLAGS} ${CPPFLAGS} ran.f
-
-together.o: together.F
- ${FC} ${FFLAGS} ${CPPFLAGS} together.F
-
-test.o: test.F
- ${FC} ${FFLAGS} ${CPPFLAGS} test.F
-
-chainbuild.o: chainbuild.F
- ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
-
-matmult.o: matmult.f
- ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
-
-parmread.o : parmread.F
- ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
-
-intcor.o : intcor.f
- ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
-
-cartder.o : cartder.F
- ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
-
-readpdb.o : readpdb.f
- ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f
-
-sumsld.o : sumsld.f
- ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
-
-cored.o : cored.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f
-
-rmdd.o : rmdd.f
- ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f
-
-energy_p_new.o : energy_p_new.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F
-
-energy_p_new-sep.o : energy_p_new-sep.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F
-
-lagrangian_lesyng.o : lagrangian_lesyng.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F
-
-blas.o : blas.f
- ${FC} ${FFLAGS1} blas.f
-
-add.o : add.f
- ${FC} ${FFLAGS1} add.f
-
-eigen.o : eigen.f
- ${FC} ${FFLAGS1} eigen.f
-
-proc_proc.o: proc_proc.c
- ${CC} ${CFLAGS} proc_proc.c
+++ /dev/null
-#
-FC= ftn
-OPT = -fast \
--Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \
--Mprefetch=distance:8,nta
-
-#OPT = -C -g
-#OPT1 = -g -fast
-OPT1 = -fast
-OPT2 = -fast
-OPT2 = ${OPT}
-OPTE = ${OPT}
-
-FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
-FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include
-FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include
-FFLAGSE = ${FFLAGS}
-
-CFLAGS = -DSGI -c
-
-BIN = ../bin/unres_MD_Tc_procor-newmat-matgather-oldparm.exe
-LIBS = xdrf/libxdrf.a
-
-CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \
- -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC -DPARINT -DPARINTDER \
- -DCRYST_BOND -DCRYST_THETA -DCRYST_SC
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-
-all: unres
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new.o \
- energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \
- indexx.o MP.o compare_s1.o prng.o \
- test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o
-
-unres: ${object} proc_proc.o
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN}
-
-
-clean:
- /bin/rm *.o
-
-newconf.o: newconf.f
- ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f
-
-bank.o: bank.F
- ${FC} ${FFLAGS} ${CPPFLAGS} bank.F
-
-diff12.o: diff12.f
- ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f
-
-csa.o: csa.f
- ${FC} ${FFLAGS} ${CPPFLAGS} csa.f
-
-shift.o: shift.F
- ${FC} ${FFLAGS} ${CPPFLAGS} shift.F
-
-ran.o: ran.f
- ${FC} ${FFLAGS} ${CPPFLAGS} ran.f
-
-together.o: together.F
- ${FC} ${FFLAGS} ${CPPFLAGS} together.F
-
-test.o: test.F
- ${FC} ${FFLAGS} ${CPPFLAGS} test.F
-
-chainbuild.o: chainbuild.F
- ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
-
-matmult.o: matmult.f
- ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
-
-parmread.o : parmread.F
- ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
-
-intcor.o : intcor.f
- ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
-
-cartder.o : cartder.F
- ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
-
-readpdb.o : readpdb.f
- ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f
-
-sumsld.o : sumsld.f
- ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
-
-cored.o : cored.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f
-
-rmdd.o : rmdd.f
- ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f
-
-energy_p_new.o : energy_p_new.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F
-
-energy_p_new-sep.o : energy_p_new-sep.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F
-
-lagrangian_lesyng.o : lagrangian_lesyng.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F
-
-blas.o : blas.f
- ${FC} ${FFLAGS1} blas.f
-
-add.o : add.f
- ${FC} ${FFLAGS1} add.f
-
-eigen.o : eigen.f
- ${FC} ${FFLAGS1} eigen.f
-
-proc_proc.o: proc_proc.c
- ${CC} ${CFLAGS} proc_proc.c
+++ /dev/null
-#
-#FC= ftn
-TAU_MAKEFILE=/usr/local/packages/TAU-2.17/tau-2.17/xt3/lib/Makefile.tau-mpi-pdt-pgi
-FC=tau_f90.sh
-OPT = -fast \
--Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \
--Mprefetch=distance:8,nta
-
-#OPT = -C -g
-#OPT1 = -g -fast
-OPT1 = -fast
-OPT2 = -fast
-OPT2 = ${OPT}
-OPTE = ${OPT}
-
-FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
-FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include
-FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include
-FFLAGSE = ${FFLAGS}
-
-CFLAGS = -DSGI -c
-
-BIN = ../bin/unres_MD_Tc_procor-newmat-noparint-barrier-tau.exe
-LIBS = xdrf/libxdrf.a
-
-CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \
- -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-
-all: unres
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \
- energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \
- indexx.o MP.o compare_s1.o prng.o \
- test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o
-
-unres: ${object} proc_proc.o
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN}
-
-
-clean:
- /bin/rm *.o *.pp.[fF] *.pp.inst.[fF]
-
-newconf.o: newconf.f
- ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f
-
-bank.o: bank.F
- ${FC} ${FFLAGS} ${CPPFLAGS} bank.F
-
-diff12.o: diff12.f
- ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f
-
-csa.o: csa.f
- ${FC} ${FFLAGS} ${CPPFLAGS} csa.f
-
-shift.o: shift.F
- ${FC} ${FFLAGS} ${CPPFLAGS} shift.F
-
-ran.o: ran.f
- ${FC} ${FFLAGS} ${CPPFLAGS} ran.f
-
-together.o: together.F
- ${FC} ${FFLAGS} ${CPPFLAGS} together.F
-
-test.o: test.F
- ${FC} ${FFLAGS} ${CPPFLAGS} test.F
-
-chainbuild.o: chainbuild.F
- ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
-
-matmult.o: matmult.f
- ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
-
-parmread.o : parmread.F
- ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
-
-intcor.o : intcor.f
- ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
-
-cartder.o : cartder.F
- ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
-
-readpdb.o : readpdb.f
- ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f
-
-sumsld.o : sumsld.f
- ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
-
-cored.o : cored.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f
-
-rmdd.o : rmdd.f
- ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f
-
-energy_p_new.o : energy_p_new.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F
-
-energy_p_new-sep.o : energy_p_new-sep.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F
-
-lagrangian_lesyng.o : lagrangian_lesyng.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F
-
-blas.o : blas.f
- ${FC} ${FFLAGS1} blas.f
-
-add.o : add.f
- ${FC} ${FFLAGS1} add.f
-
-eigen.o : eigen.f
- ${FC} ${FFLAGS1} eigen.f
-
-proc_proc.o: proc_proc.c
- ${CC} ${CFLAGS} proc_proc.c
+++ /dev/null
-CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DMP -DMPI -DPGI -DISNAN \
- -DSPLITELE -DAMD64 -DLANG0
-# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC
-#-DCRYST_TOR
-# -DPROCOR
-# -DTSCSC
-#-DTIMING \
-# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC
-# -DMOMENT
-#-DPARVEC
-#-DPARINT -DPARINTDER
-
-#INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/
-#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh
-#INSTALL_DIR = /users/software/mpich2.x86_64/
-#INSTALL_DIR = /opt/mpi/mvapich2
-INSTALL_DIR = /opt/mpi/mvapich
-
-FC= ifort
-FCL= ${INSTALL_DIR}/bin/mpif77
-
-OPT = -O3 -ip -w -xHost
-
-FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
-FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include
-FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include
-FFLAGSE = -c -w -xHost -O3 -ipo -ipo_obj -no-prec-div -opt_report -I$(INSTALL_DIR)/include
-
-
-BIN = ../bin/unres_Tc_procor_new_em64_hremd_mpich1.exe
-LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -lpthread
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-
-all: unres
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \
- energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \
- indexx.o MP.o compare_s1.o prng_32.o \
- test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o
-
-unres: ${object}
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FCL} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
-
-
-clean:
- /bin/rm *.o *.il
-
-newconf.o: newconf.f
- ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f
-
-bank.o: bank.F
- ${FC} ${FFLAGS} ${CPPFLAGS} bank.F
-
-diff12.o: diff12.f
- ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f
-
-csa.o: csa.f
- ${FC} ${FFLAGS} ${CPPFLAGS} csa.f
-
-shift.o: shift.F
- ${FC} ${FFLAGS} ${CPPFLAGS} shift.F
-
-ran.o: ran.f
- ${FC} ${FFLAGS} ${CPPFLAGS} ran.f
-
-together.o: together.F
- ${FC} ${FFLAGS} ${CPPFLAGS} together.F
-
-test.o: test.F
- ${FC} ${FFLAGS} ${CPPFLAGS} test.F
-
-chainbuild.o: chainbuild.F
- ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
-
-matmult.o: matmult.f
- ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
-
-parmread.o : parmread.F
- ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
-
-intcor.o : intcor.f
- ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
-
-cartder.o : cartder.F
- ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
-
-readpdb.o : readpdb.F
- ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F
-
-sumsld.o : sumsld.f
- ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
-
-cored.o : cored.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f
-
-rmdd.o : rmdd.f
- ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f
-
-energy_p_new_barrier.o : energy_p_new_barrier.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F
-
-gradient_p.o : gradient_p.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F
-
-energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F
-
-lagrangian_lesyng.o : lagrangian_lesyng.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F
-
-MD_A-MTS.o : MD_A-MTS.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F
-
-blas.o : blas.f
- ${FC} ${FFLAGS1} blas.f
-
-add.o : add.f
- ${FC} ${FFLAGS1} add.f
-
-eigen.o : eigen.f
- ${FC} ${FFLAGS2} eigen.f
-
-proc_proc.o: proc_proc.c
- ${CC} ${CFLAGS} proc_proc.c
+++ /dev/null
-#
-FC=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77
-OPT = -O4 -qarch=450 -qtune=450
-#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace
-#OPT = -O -qarch=450 -qtune=450
-#OPT = -O0 -C -g -qarch=450 -qtune=450 #-qdebug=function_trace
-#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \
-#-Mprefetch=distance:8,nta
-
-#OPT1 = -O -g -qarch=450 -qtune=450
-#OPT1 = -O -g -qarch=450 -qtune=450 -qdebug=function_trace
-OPT1 = ${OPT}
-#OPT2 = -O2 -qarch=450 -qtune=450
-#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace
-OPT2 = ${OPT}
-#OPTE = -O4 -qarch=450 -qtune=450
-#OPTE = -O4 -qarch=450 -qtune=450
-OPTE=${OPT}
-
-CFLAGS = -c
-FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
-FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include
-FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include
-FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include
-
-BIN = ../bin/unres_MD_Tc_procor-newparm-O4-parcorr.exe
-#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-PARINT-parcorr.exe
-#BIN = ../bin/unres_MD_Tc_procor-newparm-parvecmatint-O4-notau1.exe
-#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-notau1.exe
-#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a
-LIBS = xdrf/libxdrf.a
-
-CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \
- -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0
-#-WF,-DPARINT -WF,-DPARINTDER
-#-WF,-DPARVEC -WF,-DPARMAT -WF,-DMATGATHER
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-
-all: unres
-
-obj: ${object}
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \
- energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \
- indexx.o MP.o compare_s1.o prng.o \
- test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o
-
-unres: ${object}
- ${CC} -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
-
-
-clean:
- /bin/rm *.o
-
-newconf.o: newconf.f
- ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f
-
-bank.o: bank.F
- ${FC} ${FFLAGS} ${CPPFLAGS} bank.F
-
-diff12.o: diff12.f
- ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f
-
-csa.o: csa.f
- ${FC} ${FFLAGS} ${CPPFLAGS} csa.f
-
-shift.o: shift.F
- ${FC} ${FFLAGS} ${CPPFLAGS} shift.F
-
-ran.o: ran.f
- ${FC} ${FFLAGS} ${CPPFLAGS} ran.f
-
-together.o: together.F
- ${FC} ${FFLAGS} ${CPPFLAGS} together.F
-
-test.o: test.F
- ${FC} ${FFLAGS} ${CPPFLAGS} test.F
-
-chainbuild.o: chainbuild.F
- ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
-
-matmult.o: matmult.f
- ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
-
-parmread.o : parmread.F
- ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
-
-intcor.o : intcor.f
- ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
-
-cartder.o : cartder.F
- ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
-
-readpdb.o : readpdb.f
- ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f
-
-sumsld.o : sumsld.f
- ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
-
-cored.o : cored.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f
-
-rmdd.o : rmdd.f
- ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f
-
-eigen.o : eigen.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f
-
-blas.o : blas.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f
-
-add.o : add.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} add.f
-
-energy_p_new.o : energy_p_new.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F
-
-energy_p_new-sep.o : energy_p_new-sep.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F
-
-lagrangian_lesyng.o : lagrangian_lesyng.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F
-
-proc_proc.o: proc_proc.c
- ${CC} ${CFLAGS} proc_proc.c
-
-compinfo: compinfo.c
- ${CC} ${CFLAGS} compinfo.c
+++ /dev/null
-FC= gfortran
-FFLAGS = -c ${OPT} -I.
-FFLAGS1 = -c ${OPT1} -I.
-
-CC = cc
-
-CFLAGS = -DLINUX -DPGI -c
-
-OPT = -O -fbounds-check -g
-OPT1 = -g
-
-#OPT = -fbounds-check -g
-#OPT1 = -g
-
-# -Mvect <---slows down
-# -Minline=name:matmat2 <---false convergence
-
-LIBS = -Lxdrf -lxdrf
-#-DMOMENT
-#-DCO_BIAS
-#-DCRYST_TOR
-#-DDEBUG
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-all:
- @echo "Specify force field: GAB or E0LL2Y"
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \
- energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- MP.o compare_s1.o prng_32.o \
- banach.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o test.o ssMD.o
-
-GAB: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \
- -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC
-GAB: BIN = ../../../bin/unres/MD/unres_gfortran_single_GAB.exe
-GAB: ${object} xdrf/libxdrf.a
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
-
-E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \
- -DSPLITELE -DLANG0
-E0LL2Y: BIN = ../../../bin/unres/MD/unres_gfortran_single_E0LL2Y.exe
-E0LL2Y: ${object} xdrf/libxdrf.a
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
-
-xdrf/libxdrf.a:
- cd xdrf && make
-
-clean:
- /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean
-
-newconf.o: newconf.F
- ${FC} ${FFLAGS} ${CPPFLAGS} newconf.F
-
-bank.o: bank.F
- ${FC} ${FFLAGS} ${CPPFLAGS} bank.F
-
-diff12.o: diff12.f
- ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f
-
-csa.o: csa.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} csa.f
-
-shift.o: shift.F
- ${FC} ${FFLAGS1} ${CPPFLAGS} shift.F
-
-ran.o: ran.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} ran.f
-
-together.o: together.F
- ${FC} ${FFLAGS} ${CPPFLAGS} together.F
-
-fitsq.o: fitsq.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} fitsq.f
-
-rmsd.o: rmsd.F
- ${FC} ${FFLAGS1} ${CPPFLAGS} rmsd.F
-
-contact.o: contact.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} contact.f
-
-minim_jlee.o: minim_jlee.F
- ${FC} ${FFLAGS1} ${CPPFLAGS} minim_jlee.F
-
-minimize_p.o: minimize_p.F
- ${FC} ${FFLAGS1} ${CPPFLAGS} minimize_p.F
-
-gen_rand_conf.o: gen_rand_conf.F
- ${FC} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F
-
-
-test.o: test.F
- ${FC} ${FFLAGS1} ${CPPFLAGS} test.F
-
-elecont.o: elecont.f
- ${FC} ${FFLAGS} ${CPPFLAGS} elecont.f
-
-eigen.o: eigen.f
- ${FC} ${FFLAGS1} eigen.f
-
-blas.o: blas.f
- ${FC} ${FFLAGS1} blas.f
-
-add.o: add.f
- ${FC} ${FFLAGS1} add.f
-
-proc_proc.o: proc_proc.c
- ${CC} ${CFLAGS} proc_proc.c
+++ /dev/null
-FC = ifort
-FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include
-FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include
-FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include
-FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include
-
-CC = cc
-
-CFLAGS = -DLINUX -DPGI -c
-
-OPT = -O3 -ip -w
-
-# -Mvect <---slows down
-# -Minline=name:matmat2 <---false convergence
-
-LIBS = -Lxdrf -lxdrf
-#-DMOMENT
-#-DCO_BIAS
-#-DCRYST_TOR
-#-DDEBUG
-
-ARCH = LINUX
-PP = /lib/cpp -P
-
-all:
- @echo "Specify force field: GAB or E0LL2Y"
-
-.SUFFIXES: .F
-.F.o:
- ${FC} ${FFLAGS} ${CPPFLAGS} $*.F
-
-object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \
- matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \
- pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \
- cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \
- energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \
- cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \
- mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \
- eigen.o blas.o add.o entmcm.o minim_mcmf.o \
- MP.o compare_s1.o prng.o \
- banach.o rmsd.o elecont.o dihed_cons.o \
- sc_move.o local_move.o \
- intcartderiv.o lagrangian_lesyng.o\
- stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \
- surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \
- q_measure.o gnmr1.o test.o ssMD.o
-
-GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \
- -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC
-GAB: BIN = ../../../bin/unres/MD/unres_ifort_single_GAB.exe
-GAB: ${object} xdrf/libxdrf.a
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
-
-E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \
- -DSPLITELE -DLANG0
-E0LL2Y: BIN = ../../../bin/unres/MD/unres_ifort_single_E0LL2Y.exe
-E0LL2Y: ${object} xdrf/libxdrf.a
- cc -o compinfo compinfo.c
- ./compinfo | true
- ${FC} ${FFLAGS} cinfo.f
- ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN}
-
-xdrf/libxdrf.a:
- cd xdrf && make
-
-clean:
- /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean
-
-test.o: test.F
- ${FC} ${FFLAGS} ${CPPFLAGS} test.F
-
-chainbuild.o: chainbuild.F
- ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F
-
-matmult.o: matmult.f
- ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f
-
-parmread.o : parmread.F
- ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F
-
-intcor.o : intcor.f
- ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f
-
-cartder.o : cartder.F
- ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F
-
-readpdb.o : readpdb.F
- ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F
-
-sumsld.o : sumsld.f
- ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f
-
-cored.o : cored.f
- ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f
-
-rmdd.o : rmdd.f
- ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f
-
-energy_p_new_barrier.o : energy_p_new_barrier.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F
-
-gradient_p.o : gradient_p.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F
-
-energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F
-
-lagrangian_lesyng.o : lagrangian_lesyng.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F
-
-MD_A-MTS.o : MD_A-MTS.F
- ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F
-
-blas.o : blas.f
- ${FC} ${FFLAGS1} blas.f
-
-add.o : add.f
- ${FC} ${FFLAGS1} add.f
-
-eigen.o : eigen.f
- ${FC} ${FFLAGS2} eigen.f
-
-proc_proc.o: proc_proc.c
- ${CC} ${CFLAGS} proc_proc.c
+++ /dev/null
-The program will fail if there is no "Makefile" file.\r
-You must copy (cp MakeXXXX Makefile) or use a symbolic link (ln -s MakeXXXX Makefile) before compiling.\r
+++ /dev/null
- SUBROUTINE ABRT
- STOP 'IN ABRT'
- END
-C*MODULE MTHLIB *DECK VCLR
- SUBROUTINE VCLR(A,INCA,N)
-C
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
-C
- DIMENSION A(*)
-C
- PARAMETER (ZERO=0.0D+00)
-C
-C ----- ZERO OUT VECTOR -A-, USING INCREMENT -INCA- -----
-C
- IF (INCA .NE. 1) GO TO 200
- DO 110 L=1,N
- A(L) = ZERO
- 110 CONTINUE
- RETURN
-C
- 200 CONTINUE
- LA=1-INCA
- DO 210 L=1,N
- LA=LA+INCA
- A(LA) = ZERO
- 210 CONTINUE
- RETURN
- END
+++ /dev/null
- FUNCTION ARCOS(X)
- implicit real*8 (a-h,o-z)
- include 'COMMON.GEO'
- IF (DABS(X).LT.1.0D0) GOTO 1
- ARCOS=PIPOL*(1.0d0-DSIGN(1.0D0,X))
- RETURN
- 1 ARCOS=DACOS(X)
- RETURN
- END
+++ /dev/null
-C
-C**********************
- SUBROUTINE BANACH(N,NMAX,A,X,osob)
-C**********************
-C Banachiewicz
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A(NMAX,NMAX),X(NMAX),D(MAXRES6)
- COMMON /BANII/ D
- logical osob
- osob=.false.
- if (dabs(a(1,1)).lt.1.0d-15) then
- osob=.true.
- return
- endif
- D(1)=1./A(1,1)
- DO 80 I=2,N
- A(I,1)=A(1,I)
- DO 81 J=2,I-1
- XX=A(J,I)
- DO 82 K=1,J-1
- XX=XX-A(I,K)*A(J,K)
- 82 CONTINUE
- A(I,J)=XX
- 81 CONTINUE
- XX=A(I,I)
- JJJJ=I-1
- DO 83 J=1,JJJJ
- AIJ=A(I,J)
- AIJD=AIJ*D(J)
- A(I,J)=AIJD
- XX=XX-AIJ*AIJD
- 83 CONTINUE
- if (dabs(xx).lt.1.0d-15) then
- osob=.true.
- return
- endif
- D(I)=1./XX
- 80 CONTINUE
-C
- CALL BANAII(N,NMAX,A,X)
- RETURN
- END
-C************************
- SUBROUTINE BANAII(N,NMAX,A,X)
-C************************
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A(NMAX,NMAX),X(NMAX),D(MAXRES6)
- COMMON /BANII/ D
- DO 90 I=1,N
- Z=X(I)
- JJJJ=I-1
- DO 91 J=JJJJ,1,-1
- Z=Z-A(I,J)*X(J)
- 91 CONTINUE
- X(I)=Z
- 90 CONTINUE
- DO 92 I=N,1,-1
- Z=X(I)*D(I)
- JJJJ=I+1
- DO 93 J=JJJJ,N
- Z=Z-A(J,I)*X(J)
- 93 CONTINUE
- X(I)=Z
- 92 CONTINUE
- RETURN
- END
-C
- SUBROUTINE MATINVERT(N,NMAX,A,A1,osob)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A(NMAX,NMAX),A1(NMAX,NMAX),D(MAXRES6)
- COMMON /BANII/ D
- DIMENSION X(NMAX)
- logical osob
- DO I=1,N
- X(I)=0.0
- ENDDO
- X(1)=1.0
- CALL BANACH(N,NMAX,A,X,osob)
- if (osob) return
- DO I=1,N
- A1(I,1)=X(I)
- ENDDO
- DO I=2,N
- DO J=1,N
- X(J)=0.0
- ENDDO
- X(I)=1.0
- CALL BANAII(N,NMAX,A,X)
- DO J=1,N
- A1(J,I)=X(J)
- ENDDO
- ENDDO
- RETURN
- END
-
-
+++ /dev/null
-C 10 NOV 94 - MWS - DNRM2: REMOVE FTNCHECK WARNINGS
-C 11 JUN 94 - MWS - INCLUDE A COPY OF DGEMV (LEVEL TWO ROUTINE)
-C 11 AUG 87 - MWS - SANITIZE FLOATING POINT CONSTANTS IN DNRM2
-C 26 MAR 87 - MWS - USE GENERIC SIGN IN DROTG
-C 28 NOV 86 - STE - SUPPLY ALL LEVEL ONE BLAS
-C 7 JUL 86 - JAB - SANITIZE FLOATING POINT CONSTANTS
-C
-C BASIC LINEAR ALGEBRA SUBPROGRAMS (BLAS) FROM LINPACK (LEVEL 1)
-C
-C THIS MODULE SHOULD BE COMPILED ONLY IF SPECIALLY CODED
-C VERSIONS OF THESE ROUTINES ARE NOT AVAILABLE ON THE TARGET MACHINE
-C
-C*MODULE BLAS1 *DECK DASUM
- DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
-C
-C TAKES THE SUM OF THE ABSOLUTE VALUES.
-C JACK DONGARRA, LINPACK, 3/11/78.
-C
- DOUBLE PRECISION DX(1),DTEMP
- INTEGER I,INCX,M,MP1,N,NINCX
-C
- DASUM = 0.0D+00
- DTEMP = 0.0D+00
- IF(N.LE.0)RETURN
- IF(INCX.EQ.1)GO TO 20
-C
-C CODE FOR INCREMENT NOT EQUAL TO 1
-C
- NINCX = N*INCX
- DO 10 I = 1,NINCX,INCX
- DTEMP = DTEMP + ABS(DX(I))
- 10 CONTINUE
- DASUM = DTEMP
- RETURN
-C
-C CODE FOR INCREMENT EQUAL TO 1
-C
-C
-C CLEAN-UP LOOP
-C
- 20 M = MOD(N,6)
- IF( M .EQ. 0 ) GO TO 40
- DO 30 I = 1,M
- DTEMP = DTEMP + ABS(DX(I))
- 30 CONTINUE
- IF( N .LT. 6 ) GO TO 60
- 40 MP1 = M + 1
- DO 50 I = MP1,N,6
- DTEMP = DTEMP + ABS(DX(I)) + ABS(DX(I + 1)) + ABS(DX(I + 2))
- * + ABS(DX(I + 3)) + ABS(DX(I + 4)) + ABS(DX(I + 5))
- 50 CONTINUE
- 60 DASUM = DTEMP
- RETURN
- END
-C*MODULE BLAS1 *DECK DAXPY
- SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION DX(1),DY(1)
-C
-C CONSTANT TIMES A VECTOR PLUS A VECTOR.
-C DY(I) = DY(I) + DA * DX(I)
-C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE.
-C JACK DONGARRA, LINPACK, 3/11/78.
-C
- IF(N.LE.0)RETURN
- IF (DA .EQ. 0.0D+00) RETURN
- IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
-C
-C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS
-C NOT EQUAL TO 1
-C
- IX = 1
- IY = 1
- IF(INCX.LT.0)IX = (-N+1)*INCX + 1
- IF(INCY.LT.0)IY = (-N+1)*INCY + 1
- DO 10 I = 1,N
- DY(IY) = DY(IY) + DA*DX(IX)
- IX = IX + INCX
- IY = IY + INCY
- 10 CONTINUE
- RETURN
-C
-C CODE FOR BOTH INCREMENTS EQUAL TO 1
-C
-C
-C CLEAN-UP LOOP
-C
- 20 M = MOD(N,4)
- IF( M .EQ. 0 ) GO TO 40
- DO 30 I = 1,M
- DY(I) = DY(I) + DA*DX(I)
- 30 CONTINUE
- IF( N .LT. 4 ) RETURN
- 40 MP1 = M + 1
- DO 50 I = MP1,N,4
- DY(I) = DY(I) + DA*DX(I)
- DY(I + 1) = DY(I + 1) + DA*DX(I + 1)
- DY(I + 2) = DY(I + 2) + DA*DX(I + 2)
- DY(I + 3) = DY(I + 3) + DA*DX(I + 3)
- 50 CONTINUE
- RETURN
- END
-C*MODULE BLAS1 *DECK DCOPY
- SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION DX(*),DY(*)
-C
-C COPIES A VECTOR.
-C DY(I) <== DX(I)
-C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE.
-C JACK DONGARRA, LINPACK, 3/11/78.
-C
- IF(N.LE.0)RETURN
- IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
-C
-C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS
-C NOT EQUAL TO 1
-C
- IX = 1
- IY = 1
- IF(INCX.LT.0)IX = (-N+1)*INCX + 1
- IF(INCY.LT.0)IY = (-N+1)*INCY + 1
- DO 10 I = 1,N
- DY(IY) = DX(IX)
- IX = IX + INCX
- IY = IY + INCY
- 10 CONTINUE
- RETURN
-C
-C CODE FOR BOTH INCREMENTS EQUAL TO 1
-C
-C
-C CLEAN-UP LOOP
-C
- 20 M = MOD(N,7)
- IF( M .EQ. 0 ) GO TO 40
- DO 30 I = 1,M
- DY(I) = DX(I)
- 30 CONTINUE
- IF( N .LT. 7 ) RETURN
- 40 MP1 = M + 1
- DO 50 I = MP1,N,7
- DY(I) = DX(I)
- DY(I + 1) = DX(I + 1)
- DY(I + 2) = DX(I + 2)
- DY(I + 3) = DX(I + 3)
- DY(I + 4) = DX(I + 4)
- DY(I + 5) = DX(I + 5)
- DY(I + 6) = DX(I + 6)
- 50 CONTINUE
- RETURN
- END
-C*MODULE BLAS1 *DECK DDOT
- DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION DX(1),DY(1)
-C
-C FORMS THE DOT PRODUCT OF TWO VECTORS.
-C DOT = DX(I) * DY(I)
-C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE.
-C JACK DONGARRA, LINPACK, 3/11/78.
-C
- DDOT = 0.0D+00
- DTEMP = 0.0D+00
- IF(N.LE.0)RETURN
- IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
-C
-C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS
-C NOT EQUAL TO 1
-C
- IX = 1
- IY = 1
- IF(INCX.LT.0)IX = (-N+1)*INCX + 1
- IF(INCY.LT.0)IY = (-N+1)*INCY + 1
- DO 10 I = 1,N
- DTEMP = DTEMP + DX(IX)*DY(IY)
- IX = IX + INCX
- IY = IY + INCY
- 10 CONTINUE
- DDOT = DTEMP
- RETURN
-C
-C CODE FOR BOTH INCREMENTS EQUAL TO 1
-C
-C
-C CLEAN-UP LOOP
-C
- 20 M = MOD(N,5)
- IF( M .EQ. 0 ) GO TO 40
- DO 30 I = 1,M
- DTEMP = DTEMP + DX(I)*DY(I)
- 30 CONTINUE
- IF( N .LT. 5 ) GO TO 60
- 40 MP1 = M + 1
- DO 50 I = MP1,N,5
- DTEMP = DTEMP + DX(I)*DY(I) + DX(I + 1)*DY(I + 1) +
- * DX(I + 2)*DY(I + 2) + DX(I + 3)*DY(I + 3) + DX(I + 4)*DY(I + 4)
- 50 CONTINUE
- 60 DDOT = DTEMP
- RETURN
- END
-C*MODULE BLAS1 *DECK DNRM2
- DOUBLE PRECISION FUNCTION DNRM2 ( N, DX, INCX)
- INTEGER NEXT
- DOUBLE PRECISION DX(1), CUTLO, CUTHI, HITEST, SUM, XMAX,ZERO,ONE
- DATA ZERO, ONE /0.0D+00, 1.0D+00/
-C
-C EUCLIDEAN NORM OF THE N-VECTOR STORED IN DX() WITH STORAGE
-C INCREMENT INCX .
-C IF N .LE. 0 RETURN WITH RESULT = 0.
-C IF N .GE. 1 THEN INCX MUST BE .GE. 1
-C
-C C.L.LAWSON, 1978 JAN 08
-C
-C FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE
-C HOPEFULLY APPLICABLE TO ALL MACHINES.
-C CUTLO = MAXIMUM OF SQRT(U/EPS) OVER ALL KNOWN MACHINES.
-C CUTHI = MINIMUM OF SQRT(V) OVER ALL KNOWN MACHINES.
-C WHERE
-C EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1.
-C U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT)
-C V = LARGEST NO. (OVERFLOW LIMIT)
-C
-C BRIEF OUTLINE OF ALGORITHM..
-C
-C PHASE 1 SCANS ZERO COMPONENTS.
-C MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO
-C MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO
-C MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M
-C WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX.
-C
-C VALUES FOR CUTLO AND CUTHI..
-C FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER
-C DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS..
-C CUTLO, S.P. U/EPS = 2**(-102) FOR HONEYWELL. CLOSE SECONDS ARE
-C UNIVAC AND DEC AT 2**(-103)
-C THUS CUTLO = 2**(-51) = 4.44089E-16
-C CUTHI, S.P. V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC.
-C THUS CUTHI = 2**(63.5) = 1.30438E19
-C CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC.
-C THUS CUTLO = 2**(-33.5) = 8.23181D-11
-C CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D+19
-C DATA CUTLO, CUTHI / 8.232D-11, 1.304D+19 /
-C DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 /
- DATA CUTLO, CUTHI / 8.232D-11, 1.304D+19 /
-C
- J=0
- IF(N .GT. 0) GO TO 10
- DNRM2 = ZERO
- GO TO 300
-C
- 10 ASSIGN 30 TO NEXT
- SUM = ZERO
- NN = N * INCX
-C BEGIN MAIN LOOP
- I = 1
- 20 GO TO NEXT,(30, 50, 70, 110)
- 30 IF( ABS(DX(I)) .GT. CUTLO) GO TO 85
- ASSIGN 50 TO NEXT
- XMAX = ZERO
-C
-C PHASE 1. SUM IS ZERO
-C
- 50 IF( DX(I) .EQ. ZERO) GO TO 200
- IF( ABS(DX(I)) .GT. CUTLO) GO TO 85
-C
-C PREPARE FOR PHASE 2.
- ASSIGN 70 TO NEXT
- GO TO 105
-C
-C PREPARE FOR PHASE 4.
-C
- 100 I = J
- ASSIGN 110 TO NEXT
- SUM = (SUM / DX(I)) / DX(I)
- 105 XMAX = ABS(DX(I))
- GO TO 115
-C
-C PHASE 2. SUM IS SMALL.
-C SCALE TO AVOID DESTRUCTIVE UNDERFLOW.
-C
- 70 IF( ABS(DX(I)) .GT. CUTLO ) GO TO 75
-C
-C COMMON CODE FOR PHASES 2 AND 4.
-C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW.
-C
- 110 IF( ABS(DX(I)) .LE. XMAX ) GO TO 115
- SUM = ONE + SUM * (XMAX / DX(I))**2
- XMAX = ABS(DX(I))
- GO TO 200
-C
- 115 SUM = SUM + (DX(I)/XMAX)**2
- GO TO 200
-C
-C
-C PREPARE FOR PHASE 3.
-C
- 75 SUM = (SUM * XMAX) * XMAX
-C
-C
-C FOR REAL OR D.P. SET HITEST = CUTHI/N
-C FOR COMPLEX SET HITEST = CUTHI/(2*N)
-C
- 85 HITEST = CUTHI/N
-C
-C PHASE 3. SUM IS MID-RANGE. NO SCALING.
-C
- DO 95 J =I,NN,INCX
- IF(ABS(DX(J)) .GE. HITEST) GO TO 100
- 95 SUM = SUM + DX(J)**2
- DNRM2 = SQRT( SUM )
- GO TO 300
-C
- 200 CONTINUE
- I = I + INCX
- IF ( I .LE. NN ) GO TO 20
-C
-C END OF MAIN LOOP.
-C
-C COMPUTE SQUARE ROOT AND ADJUST FOR SCALING.
-C
- DNRM2 = XMAX * SQRT(SUM)
- 300 CONTINUE
- RETURN
- END
-C*MODULE BLAS1 *DECK DROT
- SUBROUTINE DROT (N,DX,INCX,DY,INCY,C,S)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION DX(1),DY(1)
-C
-C APPLIES A PLANE ROTATION.
-C DX(I) = C*DX(I) + S*DY(I)
-C DY(I) = -S*DX(I) + C*DY(I)
-C JACK DONGARRA, LINPACK, 3/11/78.
-C
- IF(N.LE.0)RETURN
- IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
-C
-C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL
-C TO 1
-C
- IX = 1
- IY = 1
- IF(INCX.LT.0)IX = (-N+1)*INCX + 1
- IF(INCY.LT.0)IY = (-N+1)*INCY + 1
- DO 10 I = 1,N
- DTEMP = C*DX(IX) + S*DY(IY)
- DY(IY) = C*DY(IY) - S*DX(IX)
- DX(IX) = DTEMP
- IX = IX + INCX
- IY = IY + INCY
- 10 CONTINUE
- RETURN
-C
-C CODE FOR BOTH INCREMENTS EQUAL TO 1
-C
- 20 DO 30 I = 1,N
- DTEMP = C*DX(I) + S*DY(I)
- DY(I) = C*DY(I) - S*DX(I)
- DX(I) = DTEMP
- 30 CONTINUE
- RETURN
- END
-C*MODULE BLAS1 *DECK DROTG
- SUBROUTINE DROTG(DA,DB,C,S)
-C
-C CONSTRUCT GIVENS PLANE ROTATION.
-C JACK DONGARRA, LINPACK, 3/11/78.
-C
- DOUBLE PRECISION DA,DB,C,S,ROE,SCALE,R,Z
- DOUBLE PRECISION ZERO, ONE
-C
- PARAMETER (ZERO=0.0D+00, ONE=1.0D+00)
-C
-C-----------------------------------------------------------------------
-C
-C
- ROE = DB
- IF( ABS(DA) .GT. ABS(DB) ) ROE = DA
- SCALE = ABS(DA) + ABS(DB)
- IF( SCALE .NE. ZERO ) GO TO 10
- C = ONE
- S = ZERO
- R = ZERO
- GO TO 20
-C
- 10 R = SCALE*SQRT((DA/SCALE)**2 + (DB/SCALE)**2)
- R = SIGN(ONE,ROE)*R
- C = DA/R
- S = DB/R
- 20 Z = ONE
- IF( ABS(DA) .GT. ABS(DB) ) Z = S
- IF( ABS(DB) .GE. ABS(DA) .AND. C .NE. ZERO ) Z = ONE/C
- DA = R
- DB = Z
- RETURN
- END
-C*MODULE BLAS1 *DECK DSCAL
- SUBROUTINE DSCAL(N,DA,DX,INCX)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION DX(1)
-C
-C SCALES A VECTOR BY A CONSTANT.
-C DX(I) = DA * DX(I)
-C USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE.
-C JACK DONGARRA, LINPACK, 3/11/78.
-C
- IF(N.LE.0)RETURN
- IF(INCX.EQ.1)GO TO 20
-C
-C CODE FOR INCREMENT NOT EQUAL TO 1
-C
- NINCX = N*INCX
- DO 10 I = 1,NINCX,INCX
- DX(I) = DA*DX(I)
- 10 CONTINUE
- RETURN
-C
-C CODE FOR INCREMENT EQUAL TO 1
-C
-C
-C CLEAN-UP LOOP
-C
- 20 M = MOD(N,5)
- IF( M .EQ. 0 ) GO TO 40
- DO 30 I = 1,M
- DX(I) = DA*DX(I)
- 30 CONTINUE
- IF( N .LT. 5 ) RETURN
- 40 MP1 = M + 1
- DO 50 I = MP1,N,5
- DX(I) = DA*DX(I)
- DX(I + 1) = DA*DX(I + 1)
- DX(I + 2) = DA*DX(I + 2)
- DX(I + 3) = DA*DX(I + 3)
- DX(I + 4) = DA*DX(I + 4)
- 50 CONTINUE
- RETURN
- END
-C*MODULE BLAS1 *DECK DSWAP
- SUBROUTINE DSWAP (N,DX,INCX,DY,INCY)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION DX(1),DY(1)
-C
-C INTERCHANGES TWO VECTORS.
-C DX(I) <==> DY(I)
-C USES UNROLLED LOOPS FOR INCREMENTS EQUAL ONE.
-C JACK DONGARRA, LINPACK, 3/11/78.
-C
- IF(N.LE.0)RETURN
- IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
-C
-C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL
-C TO 1
-C
- IX = 1
- IY = 1
- IF(INCX.LT.0)IX = (-N+1)*INCX + 1
- IF(INCY.LT.0)IY = (-N+1)*INCY + 1
- DO 10 I = 1,N
- DTEMP = DX(IX)
- DX(IX) = DY(IY)
- DY(IY) = DTEMP
- IX = IX + INCX
- IY = IY + INCY
- 10 CONTINUE
- RETURN
-C
-C CODE FOR BOTH INCREMENTS EQUAL TO 1
-C
-C
-C CLEAN-UP LOOP
-C
- 20 M = MOD(N,3)
- IF( M .EQ. 0 ) GO TO 40
- DO 30 I = 1,M
- DTEMP = DX(I)
- DX(I) = DY(I)
- DY(I) = DTEMP
- 30 CONTINUE
- IF( N .LT. 3 ) RETURN
- 40 MP1 = M + 1
- DO 50 I = MP1,N,3
- DTEMP = DX(I)
- DX(I) = DY(I)
- DY(I) = DTEMP
- DTEMP = DX(I + 1)
- DX(I + 1) = DY(I + 1)
- DY(I + 1) = DTEMP
- DTEMP = DX(I + 2)
- DX(I + 2) = DY(I + 2)
- DY(I + 2) = DTEMP
- 50 CONTINUE
- RETURN
- END
-C*MODULE BLAS1 *DECK IDAMAX
- INTEGER FUNCTION IDAMAX(N,DX,INCX)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION DX(1)
-C
-C FINDS THE INDEX OF ELEMENT HAVING MAX. ABSOLUTE VALUE.
-C JACK DONGARRA, LINPACK, 3/11/78.
-C
- IDAMAX = 0
- IF( N .LT. 1 ) RETURN
- IDAMAX = 1
- IF(N.EQ.1)RETURN
- IF(INCX.EQ.1)GO TO 20
-C
-C CODE FOR INCREMENT NOT EQUAL TO 1
-C
- IX = 1
- RMAX = ABS(DX(1))
- IX = IX + INCX
- DO 10 I = 2,N
- IF(ABS(DX(IX)).LE.RMAX) GO TO 5
- IDAMAX = I
- RMAX = ABS(DX(IX))
- 5 IX = IX + INCX
- 10 CONTINUE
- RETURN
-C
-C CODE FOR INCREMENT EQUAL TO 1
-C
- 20 RMAX = ABS(DX(1))
- DO 30 I = 2,N
- IF(ABS(DX(I)).LE.RMAX) GO TO 30
- IDAMAX = I
- RMAX = ABS(DX(I))
- 30 CONTINUE
- RETURN
- END
-C*MODULE BLAS *DECK DGEMV
- SUBROUTINE DGEMV(FORMA,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- CHARACTER*1 FORMA
- DIMENSION A(LDA,*),X(*),Y(*)
- PARAMETER (ZERO=0.0D+00, ONE=1.0D+00)
-C
-C CLONE OF -DGEMV- WRITTEN BY MIKE SCHMIDT
-C
- LOCY = 1
- IF(FORMA.EQ.'T') GO TO 200
-C
-C Y = ALPHA * A * X + BETA * Y
-C
- IF(ALPHA.EQ.ONE .AND. BETA.EQ.ZERO) THEN
- DO 110 I=1,M
- Y(LOCY) = DDOT(N,A(I,1),LDA,X,INCX)
- LOCY = LOCY+INCY
- 110 CONTINUE
- ELSE
- DO 120 I=1,M
- Y(LOCY) = ALPHA*DDOT(N,A(I,1),LDA,X,INCX) + BETA*Y(LOCY)
- LOCY = LOCY+INCY
- 120 CONTINUE
- END IF
- RETURN
-C
-C Y = ALPHA * A-TRANSPOSE * X + BETA * Y
-C
- 200 CONTINUE
- IF(ALPHA.EQ.ONE .AND. BETA.EQ.ZERO) THEN
- DO 210 I=1,N
- Y(LOCY) = DDOT(M,A(1,I),1,X,INCX)
- LOCY = LOCY+INCY
- 210 CONTINUE
- ELSE
- DO 220 I=1,N
- Y(LOCY) = ALPHA*DDOT(M,A(1,I),1,X,INCX) + BETA*Y(LOCY)
- LOCY = LOCY+INCY
- 220 CONTINUE
- END IF
- RETURN
- END
+++ /dev/null
- subroutine bond_move(nbond,nstart,psi,lprint,error)
-C Move NBOND fragment starting from the CA(nstart) by angle PSI.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- integer nbond,nstart
- double precision psi
- logical fail,error,lprint
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.MCM'
- dimension x(3),e(3,3),e1(3),e2(3),e3(3),rot(3,3),trans(3,3)
- error=.false.
- nend=nstart+nbond
- if (print_mc.gt.2) then
- write (iout,*) 'nstart=',nstart,' nend=',nend,' nbond=',nbond
- write (iout,*) 'psi=',psi
- write (iout,'(a)') 'Original coordinates of the fragment'
- do i=nstart,nend
- write (iout,'(i5,3f10.5)') i,(c(j,i),j=1,3)
- enddo
- endif
- if (nstart.lt.1 .or. nend .gt.nres .or. nbond.lt.2 .or.
- & nbond.ge.nres-1) then
- write (iout,'(a)') 'Bad data in BOND_MOVE.'
- error=.true.
- return
- endif
-C Generate the reference system.
- i2=nend
- i3=nstart
- i4=nstart+1
- call refsys(i2,i3,i4,e1,e2,e3,error)
-C Return, if couldn't define the reference system.
- if (error) return
-C Compute the transformation matrix.
- cospsi=dcos(psi)
- sinpsi=dsin(psi)
- rot(1,1)=1.0D0
- rot(1,2)=0.0D0
- rot(1,3)=0.0D0
- rot(2,1)=0.0D0
- rot(2,2)=cospsi
- rot(2,3)=-sinpsi
- rot(3,1)=0.0D0
- rot(3,2)=sinpsi
- rot(3,3)=cospsi
- do i=1,3
- e(1,i)=e1(i)
- e(2,i)=e2(i)
- e(3,i)=e3(i)
- enddo
-
- if (print_mc.gt.2) then
- write (iout,'(a)') 'Reference system and matrix r:'
- do i=1,3
- write(iout,'(i5,2(3f10.5,5x))')i,(e(i,j),j=1,3),(rot(i,j),j=1,3)
- enddo
- endif
-
- call matmult(rot,e,trans)
- do i=1,3
- do j=1,3
- e(i,1)=e1(i)
- e(i,2)=e2(i)
- e(i,3)=e3(i)
- enddo
- enddo
- call matmult(e,trans,trans)
-
- if (lprint) then
- write (iout,'(a)') 'The trans matrix:'
- do i=1,3
- write (iout,'(i5,3f10.5)') i,(trans(i,j),j=1,3)
- enddo
- endif
-
- do i=nstart,nend
- do j=1,3
- rij=c(j,nstart)
- do k=1,3
- rij=rij+trans(j,k)*(c(k,i)-c(k,nstart))
- enddo
- x(j)=rij
- enddo
- do j=1,3
- c(j,i)=x(j)
- enddo
- enddo
-
- if (lprint) then
- write (iout,'(a)') 'Rotated coordinates of the fragment'
- do i=nstart,nend
- write (iout,'(i5,3f10.5)') i,(c(j,i),j=1,3)
- enddo
- endif
-
-c call int_from_cart(.false.,lprint)
- if (nstart.gt.1) then
- theta(nstart+1)=alpha(nstart-1,nstart,nstart+1)
- phi(nstart+2)=beta(nstart-1,nstart,nstart+1,nstart+2)
- if (nstart.gt.2) phi(nstart+1)=
- & beta(nstart-2,nstart-1,nstart,nstart+1)
- endif
- if (nend.lt.nres) then
- theta(nend+1)=alpha(nend-1,nend,nend+1)
- phi(nend+1)=beta(nend-2,nend-1,nend,nend+1)
- if (nend.lt.nres-1) phi(nend+2)=
- & beta(nend-1,nend,nend+1,nend+2)
- endif
- if (print_mc.gt.2) then
- write (iout,'(/a,i3,a,i3,a/)')
- & 'Moved internal coordinates of the ',nstart,'-',nend,
- & ' fragment:'
- do i=nstart+1,nstart+2
- write (iout,'(i5,2f10.5)') i,rad2deg*theta(i),rad2deg*phi(i)
- enddo
- do i=nend+1,nend+2
- write (iout,'(i5,2f10.5)') i,rad2deg*theta(i),rad2deg*phi(i)
- enddo
- endif
- return
- end
+++ /dev/null
-cmake /users/czarek/UNRES/GIT/unres/ -DMPIF_LOCAL_DIR=/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh
\ No newline at end of file
+++ /dev/null
- subroutine cartder
-***********************************************************************
-* This subroutine calculates the derivatives of the consecutive virtual
-* bond vectors and the SC vectors in the virtual-bond angles theta and
-* virtual-torsional angles phi, as well as the derivatives of SC vectors
-* in the angles alpha and omega, describing the location of a side chain
-* in its local coordinate system.
-*
-* The derivatives are stored in the following arrays:
-*
-* DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
-* The structure is as follows:
-*
-* dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
-* dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4)
-* . . . . . . . . . . . . . . . . . .
-* dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4)
-* .
-* .
-* .
-* dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N)
-*
-* DXDV - the derivatives of the side-chain vectors in theta and phi.
-* The structure is same as above.
-*
-* DCDS - the derivatives of the side chain vectors in the local spherical
-* andgles alph and omega:
-*
-* dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2)
-* dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3)
-* .
-* .
-* .
-* dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1)
-*
-* Version of March '95, based on an early version of November '91.
-*
-***********************************************************************
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- dimension drt(3,3,maxres),rdt(3,3,maxres),dp(3,3),temp(3,3),
- & fromto(3,3,maxdim),prordt(3,3,maxres),prodrt(3,3,maxres)
- dimension xx(3),xx1(3)
-c common /przechowalnia/ fromto
-* get the position of the jth ijth fragment of the chain coordinate system
-* in the fromto array.
- indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
-*
-* calculate the derivatives of transformation matrix elements in theta
-*
- do i=1,nres-2
- rdt(1,1,i)=-rt(1,2,i)
- rdt(1,2,i)= rt(1,1,i)
- rdt(1,3,i)= 0.0d0
- rdt(2,1,i)=-rt(2,2,i)
- rdt(2,2,i)= rt(2,1,i)
- rdt(2,3,i)= 0.0d0
- rdt(3,1,i)=-rt(3,2,i)
- rdt(3,2,i)= rt(3,1,i)
- rdt(3,3,i)= 0.0d0
- enddo
-*
-* derivatives in phi
-*
- do i=2,nres-2
- drt(1,1,i)= 0.0d0
- drt(1,2,i)= 0.0d0
- drt(1,3,i)= 0.0d0
- drt(2,1,i)= rt(3,1,i)
- drt(2,2,i)= rt(3,2,i)
- drt(2,3,i)= rt(3,3,i)
- drt(3,1,i)=-rt(2,1,i)
- drt(3,2,i)=-rt(2,2,i)
- drt(3,3,i)=-rt(2,3,i)
- enddo
-*
-* generate the matrix products of type r(i)t(i)...r(j)t(j)
-*
- do i=2,nres-2
- ind=indmat(i,i+1)
- do k=1,3
- do l=1,3
- temp(k,l)=rt(k,l,i)
- enddo
- enddo
- do k=1,3
- do l=1,3
- fromto(k,l,ind)=temp(k,l)
- enddo
- enddo
- do j=i+1,nres-2
- ind=indmat(i,j+1)
- do k=1,3
- do l=1,3
- dpkl=0.0d0
- do m=1,3
- dpkl=dpkl+temp(k,m)*rt(m,l,j)
- enddo
- dp(k,l)=dpkl
- fromto(k,l,ind)=dpkl
- enddo
- enddo
- do k=1,3
- do l=1,3
- temp(k,l)=dp(k,l)
- enddo
- enddo
- enddo
- enddo
-*
-* Calculate derivatives.
-*
- ind1=0
- do i=1,nres-2
- ind1=ind1+1
-*
-* Derivatives of DC(i+1) in theta(i+2)
-*
- do j=1,3
- do k=1,2
- dpjk=0.0D0
- do l=1,3
- dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
- enddo
- dp(j,k)=dpjk
- prordt(j,k,i)=dp(j,k)
- enddo
- dp(j,3)=0.0D0
- dcdv(j,ind1)=vbld(i+1)*dp(j,1)
- enddo
-*
-* Derivatives of SC(i+1) in theta(i+2)
-*
- xx1(1)=-0.5D0*xloc(2,i+1)
- xx1(2)= 0.5D0*xloc(1,i+1)
- do j=1,3
- xj=0.0D0
- do k=1,2
- xj=xj+r(j,k,i)*xx1(k)
- enddo
- xx(j)=xj
- enddo
- do j=1,3
- rj=0.0D0
- do k=1,3
- rj=rj+prod(j,k,i)*xx(k)
- enddo
- dxdv(j,ind1)=rj
- enddo
-*
-* Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
-* than the other off-diagonal derivatives.
-*
- do j=1,3
- dxoiij=0.0D0
- do k=1,3
- dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
- enddo
- dxdv(j,ind1+1)=dxoiij
- enddo
-cd print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
-*
-* Derivatives of DC(i+1) in phi(i+2)
-*
- do j=1,3
- do k=1,3
- dpjk=0.0
- do l=2,3
- dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
- enddo
- dp(j,k)=dpjk
- prodrt(j,k,i)=dp(j,k)
- enddo
- dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
- enddo
-*
-* Derivatives of SC(i+1) in phi(i+2)
-*
- xx(1)= 0.0D0
- xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
- xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
- do j=1,3
- rj=0.0D0
- do k=2,3
- rj=rj+prod(j,k,i)*xx(k)
- enddo
- dxdv(j+3,ind1)=-rj
- enddo
-*
-* Derivatives of SC(i+1) in phi(i+3).
-*
- do j=1,3
- dxoiij=0.0D0
- do k=1,3
- dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
- enddo
- dxdv(j+3,ind1+1)=dxoiij
- enddo
-*
-* Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
-* theta(nres) and phi(i+3) thru phi(nres).
-*
- do j=i+1,nres-2
- ind1=ind1+1
- ind=indmat(i+1,j+1)
-cd print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
- do k=1,3
- do l=1,3
- tempkl=0.0D0
- do m=1,2
- tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
- enddo
- temp(k,l)=tempkl
- enddo
- enddo
-cd print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
-cd print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
-cd print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
-* Derivatives of virtual-bond vectors in theta
- do k=1,3
- dcdv(k,ind1)=vbld(i+1)*temp(k,1)
- enddo
-cd print '(3f8.3)',(dcdv(k,ind1),k=1,3)
-* Derivatives of SC vectors in theta
- do k=1,3
- dxoijk=0.0D0
- do l=1,3
- dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
- enddo
- dxdv(k,ind1+1)=dxoijk
- enddo
-*
-*--- Calculate the derivatives in phi
-*
- do k=1,3
- do l=1,3
- tempkl=0.0D0
- do m=1,3
- tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
- enddo
- temp(k,l)=tempkl
- enddo
- enddo
- do k=1,3
- dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
- enddo
- do k=1,3
- dxoijk=0.0D0
- do l=1,3
- dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
- enddo
- dxdv(k+3,ind1+1)=dxoijk
- enddo
- enddo
- enddo
-*
-* Derivatives in alpha and omega:
-*
- do i=2,nres-1
-c dsci=dsc(itype(i))
- dsci=vbld(i+nres)
-#ifdef OSF
- alphi=alph(i)
- omegi=omeg(i)
- if(alphi.ne.alphi) alphi=100.0
- if(omegi.ne.omegi) omegi=-100.0
-#else
- alphi=alph(i)
- omegi=omeg(i)
-#endif
-cd print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
- cosalphi=dcos(alphi)
- sinalphi=dsin(alphi)
- cosomegi=dcos(omegi)
- sinomegi=dsin(omegi)
- temp(1,1)=-dsci*sinalphi
- temp(2,1)= dsci*cosalphi*cosomegi
- temp(3,1)=-dsci*cosalphi*sinomegi
- temp(1,2)=0.0D0
- temp(2,2)=-dsci*sinalphi*sinomegi
- temp(3,2)=-dsci*sinalphi*cosomegi
- theta2=pi-0.5D0*theta(i+1)
- cost2=dcos(theta2)
- sint2=dsin(theta2)
- jjj=0
-cd print *,((temp(l,k),l=1,3),k=1,2)
- do j=1,2
- xp=temp(1,j)
- yp=temp(2,j)
- xxp= xp*cost2+yp*sint2
- yyp=-xp*sint2+yp*cost2
- zzp=temp(3,j)
- xx(1)=xxp
- xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
- xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
- do k=1,3
- dj=0.0D0
- do l=1,3
- dj=dj+prod(k,l,i-1)*xx(l)
- enddo
- dxds(jjj+k,i)=dj
- enddo
- jjj=jjj+3
- enddo
- enddo
- return
- end
-
+++ /dev/null
- subroutine cartprint
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- write (iout,100)
- do i=1,nres
- write (iout,110) restyp(itype(i)),i,c(1,i),c(2,i),
- & c(3,i),c(1,nres+i),c(2,nres+i),c(3,nres+i)
- enddo
- 100 format (//' alpha-carbon coordinates ',
- & ' centroid coordinates'/
- 1 ' ', 6X,'X',11X,'Y',11X,'Z',
- & 10X,'X',11X,'Y',11X,'Z')
- 110 format (a,'(',i3,')',6f12.5)
- return
- end
+++ /dev/null
- subroutine chainbuild
-C
-C Build the virtual polypeptide chain. Side-chain centroids are moveable.
-C As of 2/17/95.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- logical lprn
-C Set lprn=.true. for debugging
- lprn = .false.
-C
-C Define the origin and orientation of the coordinate system and locate the
-C first three CA's and SC(2).
-C
- call orig_frame
-*
-* Build the alpha-carbon chain.
-*
- do i=4,nres
- call locate_next_res(i)
- enddo
-C
-C First and last SC must coincide with the corresponding CA.
-C
- do j=1,3
- dc(j,nres+1)=0.0D0
- dc_norm(j,nres+1)=0.0D0
- dc(j,nres+nres)=0.0D0
- dc_norm(j,nres+nres)=0.0D0
- c(j,nres+1)=c(j,1)
- c(j,nres+nres)=c(j,nres)
- enddo
-*
-* Temporary diagnosis
-*
- if (lprn) then
-
- call cartprint
- write (iout,'(/a)') 'Recalculated internal coordinates'
- do i=2,nres-1
- do j=1,3
- c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1))
- enddo
- be=0.0D0
- if (i.gt.3) be=rad2deg*beta(i-3,i-2,i-1,i)
- be1=rad2deg*beta(nres+i,i,maxres2,i+1)
- alfai=0.0D0
- if (i.gt.2) alfai=rad2deg*alpha(i-2,i-1,i)
- write (iout,1212) restyp(itype(i)),i,dist(i-1,i),
- & alfai,be,dist(nres+i,i),rad2deg*alpha(nres+i,i,maxres2),be1
- enddo
- 1212 format (a3,'(',i3,')',2(f10.5,2f10.2))
-
- endif
-
- return
- end
-c-------------------------------------------------------------------------
- subroutine orig_frame
-C
-C Define the origin and orientation of the coordinate system and locate
-C the first three atoms.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- cost=dcos(theta(3))
- sint=dsin(theta(3))
- t(1,1,1)=-cost
- t(1,2,1)=-sint
- t(1,3,1)= 0.0D0
- t(2,1,1)=-sint
- t(2,2,1)= cost
- t(2,3,1)= 0.0D0
- t(3,1,1)= 0.0D0
- t(3,2,1)= 0.0D0
- t(3,3,1)= 1.0D0
- r(1,1,1)= 1.0D0
- r(1,2,1)= 0.0D0
- r(1,3,1)= 0.0D0
- r(2,1,1)= 0.0D0
- r(2,2,1)= 1.0D0
- r(2,3,1)= 0.0D0
- r(3,1,1)= 0.0D0
- r(3,2,1)= 0.0D0
- r(3,3,1)= 1.0D0
- do i=1,3
- do j=1,3
- rt(i,j,1)=t(i,j,1)
- enddo
- enddo
- do i=1,3
- do j=1,3
- prod(i,j,1)=0.0D0
- prod(i,j,2)=t(i,j,1)
- enddo
- prod(i,i,1)=1.0D0
- enddo
- c(1,1)=0.0D0
- c(2,1)=0.0D0
- c(3,1)=0.0D0
- c(1,2)=vbld(2)
- c(2,2)=0.0D0
- c(3,2)=0.0D0
- dc(1,0)=0.0d0
- dc(2,0)=0.0D0
- dc(3,0)=0.0D0
- dc(1,1)=vbld(2)
- dc(2,1)=0.0D0
- dc(3,1)=0.0D0
- dc_norm(1,0)=0.0D0
- dc_norm(2,0)=0.0D0
- dc_norm(3,0)=0.0D0
- dc_norm(1,1)=1.0D0
- dc_norm(2,1)=0.0D0
- dc_norm(3,1)=0.0D0
- do j=1,3
- dc_norm(j,2)=prod(j,1,2)
- dc(j,2)=vbld(3)*prod(j,1,2)
- c(j,3)=c(j,2)+dc(j,2)
- enddo
- call locate_side_chain(2)
- return
- end
-c-----------------------------------------------------------------------------
- subroutine locate_next_res(i)
-C
-C Locate CA(i) and SC(i-1)
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
-C
-C Define the rotation matrices corresponding to CA(i)
-C
-#ifdef OSF
- theti=theta(i)
- if (theti.ne.theti) theti=100.0
- phii=phi(i)
- if (phii.ne.phii) phii=180.0
-#else
- theti=theta(i)
- phii=phi(i)
-#endif
- cost=dcos(theti)
- sint=dsin(theti)
- cosphi=dcos(phii)
- sinphi=dsin(phii)
-* Define the matrices of the rotation about the virtual-bond valence angles
-* theta, T(i,j,k), virtual-bond dihedral angles gamma (miscalled PHI in this
-* program), R(i,j,k), and, the cumulative matrices of rotation RT
- t(1,1,i-2)=-cost
- t(1,2,i-2)=-sint
- t(1,3,i-2)= 0.0D0
- t(2,1,i-2)=-sint
- t(2,2,i-2)= cost
- t(2,3,i-2)= 0.0D0
- t(3,1,i-2)= 0.0D0
- t(3,2,i-2)= 0.0D0
- t(3,3,i-2)= 1.0D0
- r(1,1,i-2)= 1.0D0
- r(1,2,i-2)= 0.0D0
- r(1,3,i-2)= 0.0D0
- r(2,1,i-2)= 0.0D0
- r(2,2,i-2)=-cosphi
- r(2,3,i-2)= sinphi
- r(3,1,i-2)= 0.0D0
- r(3,2,i-2)= sinphi
- r(3,3,i-2)= cosphi
- rt(1,1,i-2)=-cost
- rt(1,2,i-2)=-sint
- rt(1,3,i-2)=0.0D0
- rt(2,1,i-2)=sint*cosphi
- rt(2,2,i-2)=-cost*cosphi
- rt(2,3,i-2)=sinphi
- rt(3,1,i-2)=-sint*sinphi
- rt(3,2,i-2)=cost*sinphi
- rt(3,3,i-2)=cosphi
- call matmult(prod(1,1,i-2),rt(1,1,i-2),prod(1,1,i-1))
- do j=1,3
- dc_norm(j,i-1)=prod(j,1,i-1)
- dc(j,i-1)=vbld(i)*prod(j,1,i-1)
- c(j,i)=c(j,i-1)+dc(j,i-1)
- enddo
-cd print '(2i3,2(3f10.5,5x))', i-1,i,(dc(j,i-1),j=1,3),(c(j,i),j=1,3)
-C
-C Now calculate the coordinates of SC(i-1)
-C
- call locate_side_chain(i-1)
- return
- end
-c-----------------------------------------------------------------------------
- subroutine locate_side_chain(i)
-C
-C Locate the side-chain centroid i, 1 < i < NRES. Put in C(*,NRES+i).
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- dimension xx(3)
-
-c dsci=dsc(itype(i))
-c dsci_inv=dsc_inv(itype(i))
- dsci=vbld(i+nres)
- dsci_inv=vbld_inv(i+nres)
-#ifdef OSF
- alphi=alph(i)
- omegi=omeg(i)
- if (alphi.ne.alphi) alphi=100.0
- if (omegi.ne.omegi) omegi=-100.0
-#else
- alphi=alph(i)
- omegi=omeg(i)
-#endif
- cosalphi=dcos(alphi)
- sinalphi=dsin(alphi)
- cosomegi=dcos(omegi)
- sinomegi=dsin(omegi)
- xp= dsci*cosalphi
- yp= dsci*sinalphi*cosomegi
- zp=-dsci*sinalphi*sinomegi
-* Now we have to rotate the coordinate system by 180-theta(i)/2 so as to get its
-* X-axis aligned with the vector DC(*,i)
- theta2=pi-0.5D0*theta(i+1)
- cost2=dcos(theta2)
- sint2=dsin(theta2)
- xx(1)= xp*cost2+yp*sint2
- xx(2)=-xp*sint2+yp*cost2
- xx(3)= zp
-cd print '(a3,i3,3f10.5,5x,3f10.5)',restyp(itype(i)),i,
-cd & xp,yp,zp,(xx(k),k=1,3)
- do j=1,3
- xloc(j,i)=xx(j)
- enddo
-* Bring the SC vectors to the common coordinate system.
- xx(1)=xloc(1,i)
- xx(2)=xloc(2,i)*r(2,2,i-1)+xloc(3,i)*r(2,3,i-1)
- xx(3)=xloc(2,i)*r(3,2,i-1)+xloc(3,i)*r(3,3,i-1)
- do j=1,3
- xrot(j,i)=xx(j)
- enddo
- do j=1,3
- rj=0.0D0
- do k=1,3
- rj=rj+prod(j,k,i-1)*xx(k)
- enddo
- dc(j,nres+i)=rj
- dc_norm(j,nres+i)=rj*dsci_inv
- c(j,nres+i)=c(j,i)+rj
- enddo
- return
- end
+++ /dev/null
-{
- if($0==" include 'COMMON.LANGEVIN'") {
- print "#ifndef LANG0"
- print " include 'COMMON.LANGEVIN'"
- print "#else"
- print " include 'COMMON.LANGEVIN.lang0'"
- print "#endif"
- }else{
- print $0
- }
-}
+++ /dev/null
- subroutine check_bond
-C Subroutine is checking if the fitted function which describs sc_rot_pot
-C is correct, printing, alpha,beta, energy, data - for some known theta.
-C theta angle is read from the input file. Sc_rot_pot are printed
-C for the second residue in sequance.
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.CHAIN'
- double precision energia(0:n_ene)
- it=itype(2)
- do i=1,101
- vbld(nres+2)=0.5d0+0.05d0*(i-1)
- call chainbuild
- call etotal(energia)
- write (2,*) vbld(nres+2),energia(17)
- enddo
- return
- end
+++ /dev/null
- subroutine check_sc_distr
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.TIME1'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- logical fail
- double precision varia(maxvar)
- double precision hrtime,mintime,sectime
- parameter (MaxSample=10000000,delt=1.0D0/MaxSample)
- dimension prob(0:72,0:90)
- dV=2.0D0*5.0D0*deg2rad*deg2rad
- print *,'dv=',dv
- do 10 it=1,1
- if (it.eq.10) goto 10
- open (20,file=restyp(it)//'_distr.sdc',status='unknown')
- call gen_side(it,90.0D0*deg2rad,al,om,fail)
- close (20)
- goto 10
- open (20,file=restyp(it)//'_distr1.sdc',status='unknown')
- do i=0,90
- do j=0,72
- prob(j,i)=0.0D0
- enddo
- enddo
- do isample=1,MaxSample
- call gen_side(it,90.0D0*deg2rad,al,om)
- indal=rad2deg*al/2
- indom=(rad2deg*om+180.0D0)/5
- prob(indom,indal)=prob(indom,indal)+delt
- enddo
- do i=45,90
- do j=0,72
- write (20,'(2f10.3,1pd15.5)') 2*i+0.0D0,5*j-180.0D0,
- & prob(j,i)/dV
- enddo
- enddo
- 10 continue
- return
- end
+++ /dev/null
- subroutine check_cartgrad
-C Check the gradient of Cartesian coordinates in internal coordinates.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.DERIV'
- include 'COMMON.SCCOR'
- dimension temp(6,maxres),xx(3),gg(3)
- indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
-*
-* Check the gradient of the virtual-bond and SC vectors in the internal
-* coordinates.
-*
- aincr=1.0d-7
- aincr2=5.0d-8
- call cartder
- write (iout,'(a)') '**************** dx/dalpha'
- write (iout,'(a)')
- do i=2,nres-1
- alphi=alph(i)
- alph(i)=alph(i)+aincr
- do k=1,3
- temp(k,i)=dc(k,nres+i)
- enddo
- call chainbuild
- do k=1,3
- gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
- xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
- enddo
- write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)')
- & i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- alph(i)=alphi
- call chainbuild
- enddo
- write (iout,'(a)')
- write (iout,'(a)') '**************** dx/domega'
- write (iout,'(a)')
- do i=2,nres-1
- omegi=omeg(i)
- omeg(i)=omeg(i)+aincr
- do k=1,3
- temp(k,i)=dc(k,nres+i)
- enddo
- call chainbuild
- do k=1,3
- gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
- xx(k)=dabs((gg(k)-dxds(k+3,i))/
- & (aincr*dabs(dxds(k+3,i))+aincr))
- enddo
- write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)')
- & i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- omeg(i)=omegi
- call chainbuild
- enddo
- write (iout,'(a)')
- write (iout,'(a)') '**************** dx/dtheta'
- write (iout,'(a)')
- do i=3,nres
- theti=theta(i)
- theta(i)=theta(i)+aincr
- do j=i-1,nres-1
- do k=1,3
- temp(k,j)=dc(k,nres+j)
- enddo
- enddo
- call chainbuild
- do j=i-1,nres-1
- ii = indmat(i-2,j)
-c print *,'i=',i-2,' j=',j-1,' ii=',ii
- do k=1,3
- gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dxdv(k,ii))/
- & (aincr*dabs(dxdv(k,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
- & i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
- write(iout,'(a)')
- enddo
- write (iout,'(a)')
- theta(i)=theti
- call chainbuild
- enddo
- write (iout,'(a)') '***************** dx/dphi'
- write (iout,'(a)')
- do i=4,nres
- phi(i)=phi(i)+aincr
- do j=i-1,nres-1
- do k=1,3
- temp(k,j)=dc(k,nres+j)
- enddo
- enddo
- call chainbuild
- do j=i-1,nres-1
- ii = indmat(i-2,j)
-c print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dxdv(k+3,ii))/
- & (aincr*dabs(dxdv(k+3,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
- & i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
- write(iout,'(a)')
- enddo
- phi(i)=phi(i)-aincr
- call chainbuild
- enddo
- write (iout,'(a)') '****************** ddc/dtheta'
- do i=1,nres-2
- thet=theta(i+2)
- theta(i+2)=thet+aincr
- do j=i,nres
- do k=1,3
- temp(k,j)=dc(k,j)
- enddo
- enddo
- call chainbuild
- do j=i+1,nres-1
- ii = indmat(i,j)
-c print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dcdv(k,ii))/
- & (aincr*dabs(dcdv(k,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
- & i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- enddo
- do j=1,nres
- do k=1,3
- dc(k,j)=temp(k,j)
- enddo
- enddo
- theta(i+2)=thet
- enddo
- write (iout,'(a)') '******************* ddc/dphi'
- do i=1,nres-3
- phii=phi(i+3)
- phi(i+3)=phii+aincr
- do j=1,nres
- do k=1,3
- temp(k,j)=dc(k,j)
- enddo
- enddo
- call chainbuild
- do j=i+2,nres-1
- ii = indmat(i+1,j)
-c print *,'ii=',ii
- do k=1,3
- gg(k)=(dc(k,j)-temp(k,j))/aincr
- xx(k)=dabs((gg(k)-dcdv(k+3,ii))/
- & (aincr*dabs(dcdv(k+3,ii))+aincr))
- enddo
- write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
- & i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
- write (iout,'(a)')
- enddo
- do j=1,nres
- do k=1,3
- dc(k,j)=temp(k,j)
- enddo
- enddo
- phi(i+3)=phii
- enddo
- return
- end
-C----------------------------------------------------------------------------
- subroutine check_ecart
-C Check the gradient of the energy in Cartesian coordinates.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CONTACTS'
- include 'COMMON.SCCOR'
- common /srutu/ icall
- dimension ggg(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),g(maxvar)
- dimension grad_s(6,maxres)
- double precision energia(0:n_ene),energia1(0:n_ene)
- integer uiparm(1)
- double precision urparm(1)
- external fdum
- icg=1
- nf=0
- nfl=0
- call zerograd
- aincr=1.0D-7
- print '(a)','CG processor',me,' calling CHECK_CART.'
- nf=0
- icall=0
- call geom_to_var(nvar,x)
- call etotal(energia(0))
- etot=energia(0)
- call enerprint(energia(0))
- call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gradc(j,i,icg)
- grad_s(j+3,i)=gradx(j,i,icg)
- enddo
- enddo
- call flush(iout)
- write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
- do i=1,nres
- do j=1,3
- xx(j)=c(j,i+nres)
- ddc(j)=dc(j,i)
- ddx(j)=dc(j,i+nres)
- enddo
- do j=1,3
- dc(j,i)=dc(j,i)+aincr
- do k=i+1,nres
- c(j,k)=c(j,k)+aincr
- c(j,k+nres)=c(j,k+nres)+aincr
- enddo
- call etotal(energia1(0))
- etot1=energia1(0)
- ggg(j)=(etot1-etot)/aincr
- dc(j,i)=ddc(j)
- do k=i+1,nres
- c(j,k)=c(j,k)-aincr
- c(j,k+nres)=c(j,k+nres)-aincr
- enddo
- enddo
- do j=1,3
- c(j,i+nres)=c(j,i+nres)+aincr
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call etotal(energia1(0))
- etot1=energia1(0)
- ggg(j+3)=(etot1-etot)/aincr
- c(j,i+nres)=xx(j)
- dc(j,i+nres)=ddx(j)
- enddo
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)')
- & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
- enddo
- return
- end
-c----------------------------------------------------------------------------
- subroutine check_ecartint
-C Check the gradient of the energy in Cartesian coordinates.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CONTACTS'
- include 'COMMON.MD'
- include 'COMMON.LOCAL'
- include 'COMMON.SPLITELE'
- include 'COMMON.SCCOR'
- common /srutu/ icall
- dimension ggg(6),ggg1(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),
- & g(maxvar)
- dimension dcnorm_safe(3),dxnorm_safe(3)
- dimension grad_s(6,0:maxres),grad_s1(6,0:maxres)
- double precision phi_temp(maxres),theta_temp(maxres),
- & alph_temp(maxres),omeg_temp(maxres)
- double precision energia(0:n_ene),energia1(0:n_ene)
- integer uiparm(1)
- double precision urparm(1)
- external fdum
- r_cut=2.0d0
- rlambd=0.3d0
- icg=1
- nf=0
- nfl=0
- call intout
-c call intcartderiv
-c call checkintcartgrad
- call zerograd
- aincr=1.0D-5
- write(iout,*) 'Calling CHECK_ECARTINT.'
- nf=0
- icall=0
- call geom_to_var(nvar,x)
- if (.not.split_ene) then
- call etotal(energia(0))
-c do i=1,nres
-c write (iout,*) "atu?", gloc_sc(1,i,icg),gloc(i,icg)
-c enddo
- etot=energia(0)
- call enerprint(energia(0))
- call flush(iout)
- write (iout,*) "enter cartgrad"
-c do i=1,nres
-c write (iout,*) gloc_sc(1,i,icg)
-c enddo
- call flush(iout)
- call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
- icall =1
- do i=1,nres
- write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
- grad_s(j+3,i)=gxcart(j,i)
- enddo
- enddo
- else
-!- split gradient check
- call zerograd
- call etotal_long(energia(0))
- call enerprint(energia(0))
- call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
- call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
- icall =1
- write (iout,*) "longrange grad"
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
- & (gxcart(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s(j,i)=gcart(j,i)
- grad_s(j+3,i)=gxcart(j,i)
- enddo
- enddo
- call zerograd
- call etotal_short(energia(0))
- call enerprint(energia(0))
-c do i=1,nres
-c write (iout,*) gloc_sc(1,i,icg)
-c enddo
- call flush(iout)
- write (iout,*) "enter cartgrad"
- call flush(iout)
- call cartgrad
- write (iout,*) "exit cartgrad"
- call flush(iout)
- icall =1
- write (iout,*) "shortrange grad"
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
- & (gxcart(j,i),j=1,3)
- enddo
- do j=1,3
- grad_s1(j,0)=gcart(j,0)
- enddo
- do i=1,nres
- do j=1,3
- grad_s1(j,i)=gcart(j,i)
- grad_s1(j+3,i)=gxcart(j,i)
- enddo
- enddo
- endif
- write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
- do i=0,nres
- do j=1,3
- xx(j)=c(j,i+nres)
- ddc(j)=dc(j,i)
- ddx(j)=dc(j,i+nres)
- do k=1,3
- dcnorm_safe(k)=dc_norm(k,i)
- dxnorm_safe(k)=dc_norm(k,i+nres)
- enddo
- enddo
- do j=1,3
- dc(j,i)=ddc(j)+aincr
- call chainbuild_cart
-#ifdef MPI
-c Broadcast the order to compute internal coordinates to the slaves.
-c if (nfgtasks.gt.1)
-c & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
-c call int_from_cart1(.false.)
- if (.not.split_ene) then
- call etotal(energia1(0))
- etot1=energia1(0)
- else
-!- split gradient
- call etotal_long(energia1(0))
- etot11=energia1(0)
- call etotal_short(energia1(0))
- etot12=energia1(0)
-c write (iout,*) "etot11",etot11," etot12",etot12
- endif
-!- end split gradient
-c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
- dc(j,i)=ddc(j)-aincr
- call chainbuild_cart
-c call int_from_cart1(.false.)
- if (.not.split_ene) then
- call etotal(energia1(0))
- etot2=energia1(0)
- ggg(j)=(etot1-etot2)/(2*aincr)
- else
-!- split gradient
- call etotal_long(energia1(0))
- etot21=energia1(0)
- ggg(j)=(etot11-etot21)/(2*aincr)
- call etotal_short(energia1(0))
- etot22=energia1(0)
- ggg1(j)=(etot12-etot22)/(2*aincr)
-!- end split gradient
-c write (iout,*) "etot21",etot21," etot22",etot22
- endif
-c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- dc(j,i)=ddc(j)
- call chainbuild_cart
- enddo
- do j=1,3
- dc(j,i+nres)=ddx(j)+aincr
- call chainbuild_cart
-c write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
-c write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
-c write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
-c write (iout,*) "dxnormnorm",dsqrt(
-c & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
-c write (iout,*) "dxnormnormsafe",dsqrt(
-c & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
-c write (iout,*)
- if (.not.split_ene) then
- call etotal(energia1(0))
- etot1=energia1(0)
- else
-!- split gradient
- call etotal_long(energia1(0))
- etot11=energia1(0)
- call etotal_short(energia1(0))
- etot12=energia1(0)
- endif
-!- end split gradient
-c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
- dc(j,i+nres)=ddx(j)-aincr
- call chainbuild_cart
-c write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
-c write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
-c write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
-c write (iout,*)
-c write (iout,*) "dxnormnorm",dsqrt(
-c & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
-c write (iout,*) "dxnormnormsafe",dsqrt(
-c & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
- if (.not.split_ene) then
- call etotal(energia1(0))
- etot2=energia1(0)
- ggg(j+3)=(etot1-etot2)/(2*aincr)
- else
-!- split gradient
- call etotal_long(energia1(0))
- etot21=energia1(0)
- ggg(j+3)=(etot11-etot21)/(2*aincr)
- call etotal_short(energia1(0))
- etot22=energia1(0)
- ggg1(j+3)=(etot12-etot22)/(2*aincr)
-!- end split gradient
- endif
-c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
- dc(j,i+nres)=ddx(j)
- call chainbuild_cart
- enddo
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
- & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
- if (split_ene) then
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
- & i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),
- & k=1,6)
- write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
- & i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),
- & ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
- endif
- enddo
- return
- end
-c-------------------------------------------------------------------------
- subroutine int_from_cart1(lprn)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer ierror
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
- logical lprn
- if (lprn) write (iout,'(/a)') 'Recalculated internal coordinates'
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
-#if defined(PARINT) && defined(MPI)
- do i=iint_start,iint_end+1
-#else
- do i=2,nres
-#endif
- dnorm1=dist(i-1,i)
- dnorm2=dist(i,i+1)
- do j=1,3
- c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))/dnorm1
- & +(c(j,i+1)-c(j,i))/dnorm2)
- enddo
- be=0.0D0
- if (i.gt.2) then
- if (i.le.nres) phi(i+1)=beta(i-2,i-1,i,i+1)
- if ((itype(i).ne.10).and.(itype(i-1).ne.10)) then
- tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres)
- endif
- if (itype(i-1).ne.10) then
- tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1)
- omicron(1,i)=alpha(i-2,i-1,i-1+nres)
- omicron(2,i)=alpha(i-1+nres,i-1,i)
- endif
- if (itype(i).ne.10) then
- tauangle(2,i+1)=beta(i-2,i-1,i,i+nres)
- endif
- endif
- omeg(i)=beta(nres+i,i,maxres2,i+1)
- alph(i)=alpha(nres+i,i,maxres2)
- theta(i+1)=alpha(i-1,i,i+1)
- vbld(i)=dist(i-1,i)
- vbld_inv(i)=1.0d0/vbld(i)
- vbld(nres+i)=dist(nres+i,i)
- if (itype(i).ne.10) then
- vbld_inv(nres+i)=1.0d0/vbld(nres+i)
- else
- vbld_inv(nres+i)=0.0d0
- endif
- enddo
-
-#if defined(PARINT) && defined(MPI)
- if (nfgtasks1.gt.1) then
-cd write(iout,*) "iint_start",iint_start," iint_count",
-cd & (iint_count(i),i=0,nfgtasks-1)," iint_displ",
-cd & (iint_displ(i),i=0,nfgtasks-1)
-cd write (iout,*) "Gather vbld backbone"
-cd call flush(iout)
- time00=MPI_Wtime()
- call MPI_Allgatherv(vbld(iint_start),iint_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,vbld(1),iint_count(0),iint_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
-cd write (iout,*) "Gather vbld_inv"
-cd call flush(iout)
- call MPI_Allgatherv(vbld_inv(iint_start),iint_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,vbld_inv(1),iint_count(0),iint_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
-cd write (iout,*) "Gather vbld side chain"
-cd call flush(iout)
- call MPI_Allgatherv(vbld(iint_start+nres),iint_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,vbld(nres+1),iint_count(0),iint_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
-cd write (iout,*) "Gather vbld_inv side chain"
-cd call flush(iout)
- call MPI_Allgatherv(vbld_inv(iint_start+nres),
- & iint_count(fg_rank1),MPI_DOUBLE_PRECISION,vbld_inv(nres+1),
- & iint_count(0),iint_displ(0),MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
-cd write (iout,*) "Gather theta"
-cd call flush(iout)
- call MPI_Allgatherv(theta(iint_start+1),iint_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,theta(2),iint_count(0),iint_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
-cd write (iout,*) "Gather phi"
-cd call flush(iout)
- call MPI_Allgatherv(phi(iint_start+1),iint_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,phi(2),iint_count(0),iint_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
-#ifdef CRYST_SC
-cd write (iout,*) "Gather alph"
-cd call flush(iout)
- call MPI_Allgatherv(alph(iint_start),iint_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,alph(1),iint_count(0),iint_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
-cd write (iout,*) "Gather omeg"
-cd call flush(iout)
- call MPI_Allgatherv(omeg(iint_start),iint_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,omeg(1),iint_count(0),iint_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
-#endif
- time_gather=time_gather+MPI_Wtime()-time00
- endif
-#endif
- do i=1,nres-1
- do j=1,3
- dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
- enddo
- enddo
- do i=2,nres-1
- do j=1,3
- dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
- enddo
- enddo
- if (lprn) then
- do i=2,nres
- write (iout,1212) restyp(itype(i)),i,vbld(i),
- &rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),
- &rad2deg*alph(i),rad2deg*omeg(i)
- enddo
- endif
- 1212 format (a3,'(',i3,')',2(f15.10,2f10.2))
-#ifdef TIMING
- time_intfcart=time_intfcart+MPI_Wtime()-time01
-#endif
- return
- end
-c----------------------------------------------------------------------------
- subroutine check_eint
-C Check the gradient of energy in internal coordinates.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- common /srutu/ icall
- dimension x(maxvar),gana(maxvar),gg(maxvar)
- integer uiparm(1)
- double precision urparm(1)
- double precision energia(0:n_ene),energia1(0:n_ene),
- & energia2(0:n_ene)
- character*6 key
- external fdum
- call zerograd
- aincr=1.0D-7
- print '(a)','Calling CHECK_INT.'
- nf=0
- nfl=0
- icg=1
- call geom_to_var(nvar,x)
- call var_to_geom(nvar,x)
- call chainbuild
- icall=1
- print *,'ICG=',ICG
- call etotal(energia(0))
- etot = energia(0)
- call enerprint(energia(0))
- print *,'ICG=',ICG
-#ifdef MPL
- if (MyID.ne.BossID) then
- call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
- nf=x(nvar+1)
- nfl=x(nvar+2)
- icg=x(nvar+3)
- endif
-#endif
- nf=1
- nfl=3
-cd write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
- call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
-cd write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar)
- icall=1
- do i=1,nvar
- xi=x(i)
- x(i)=xi-0.5D0*aincr
- call var_to_geom(nvar,x)
- call chainbuild
- call etotal(energia1(0))
- etot1=energia1(0)
- x(i)=xi+0.5D0*aincr
- call var_to_geom(nvar,x)
- call chainbuild
- call etotal(energia2(0))
- etot2=energia2(0)
- gg(i)=(etot2-etot1)/aincr
- write (iout,*) i,etot1,etot2
- x(i)=xi
- enddo
- write (iout,'(/2a)')' Variable Numerical Analytical',
- & ' RelDiff*100% '
- do i=1,nvar
- if (i.le.nphi) then
- ii=i
- key = ' phi'
- else if (i.le.nphi+ntheta) then
- ii=i-nphi
- key=' theta'
- else if (i.le.nphi+ntheta+nside) then
- ii=i-(nphi+ntheta)
- key=' alpha'
- else
- ii=i-(nphi+ntheta+nside)
- key=' omega'
- endif
- write (iout,'(i3,a,i3,3(1pd16.6))')
- & i,key,ii,gg(i),gana(i),
- & 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
- enddo
- return
- end
+++ /dev/null
- subroutine compare_s1(n_thr,num_thread_save,energyx,x,
- & icomp,enetbss,coordss,rms_d,modif,iprint)
-C This subroutine compares the new conformation, whose variables are in X
-C with the previously accumulated conformations whose energies and variables
-C are stored in ENETBSS and COORDSS, respectively. The meaning of other
-C variables is as follows:
-C
-C N_THR - on input the previous # of accumulated confs, on output the current
-C # of accumulated confs.
-C N_REPEAT - an array that indicates how many times the structure has already
-C been used to start the reversed-reversing procedure. Addition of
-C a new structure replacement of a structure with a similar, but
-C lower-energy structure resets the respective entry in N_REPEAT to zero
-C I9 - output unit
-C ENERGYX,X - the energy and variables of the new conformations.
-C ICOMP - comparison result:
-C 0 - the new structure is similar to one of the previous ones and does
-C not have a remarkably lower energy and is therefore rejected;
-C 1 - the new structure is different and is added to the set, because
-C there is still room in the COORDSS and ENETBSS arrays;
-C 2 - the new structure is different, but higher in energy than any
-C previous one and is therefore rejected
-C 3 - there is no more room in the COORDSS and ENETBSS arrays, but
-C the new structure is lower in energy than at least the highest-
-C energy previous structure and therefore replaces it.
-C 9 - the new structure is similar to a number of previous structures,
-C but has a remarkably lower energy than any of them; therefore
-C replaces all these structures;
-C MODIF - a logical variable that shows whether to include the new structure
-C in the set of accumulated structures
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
-crc include 'COMMON.DEFORM'
- include 'COMMON.IOUNITS'
-#ifdef UNRES
- include 'COMMON.CHAIN'
-#endif
-
- dimension x(maxvar)
- dimension x1(maxvar)
- double precision przes(3),obrot(3,3)
- integer list(max_thread)
- logical non_conv,modif
- double precision enetbss(max_threadss)
- double precision coordss(maxvar,max_threadss)
-
- nlist=0
-#ifdef UNRES
- call var_to_geom(nvar,x)
- call chainbuild
- do k=1,2*nres
- do kk=1,3
- cref(kk,k)=c(kk,k)
- enddo
- enddo
-#endif
-c write(iout,*)'*ene=',energyx
- j=0
- enex_jp=-1.0d+99
- do i=1,n_thr
- do k=1,nvar
- x1(k)=coordss(k,i)
- enddo
- if (iprint.gt.3) then
- write (iout,*) 'Compare_ss, i=',i
- write (iout,*) 'New structure Energy:',energyx
- write (iout,'(10f8.3)') (rad2deg*x(k),k=1,nvar)
- write (iout,*) 'Template structure Energy:',enetbss(i)
- write (iout,'(10f8.3)') (rad2deg*x1(k),k=1,nvar)
- endif
-
-#ifdef UNRES
- call var_to_geom(nvar,x1)
- call chainbuild
-cd write(iout,*)'C and CREF'
-cd write(iout,'(i5,3f10.5,5x,3f10.5)')(k,(c(j,k),j=1,3),
-cd & (cref(j,k),j=1,3),k=1,nres)
- call fitsq(roznica,c(1,1),cref(1,1),nres,przes,obrot,non_conv)
- if (non_conv) then
- print *,'Problems in FITSQ!!!'
- print *,'X'
- print '(10f8.3)',(x(k),k=1,nvar)
- print *,'X1'
- print '(10f8.3)',(x1(k),k=1,nvar)
- print *,'C and CREF'
- print '(i5,3f10.5,5x,3f10.5)',(k,(c(j,k),j=1,3),
- & (cref(j,k),j=1,3),k=1,nres)
- endif
- roznica=dsqrt(dabs(roznica))
- iresult = 1
- if (roznica.lt.rms_d) iresult = 0
-#else
- energyy=enetbss(i)
- call cmprs(x,x1,roznica,energyx,energyy,iresult)
-#endif
- if (iprint.gt.1) write(iout,'(i5,f10.6,$)') i,roznica
-c print '(i5,f8.3)',i,roznica
- if(iresult.eq.0) then
- nlist = nlist + 1
- list(nlist)=i
- if (iprint.gt.1) write(iout,*)
- if(energyx.ge.enetbss(i)) then
- if (iprint.gt.1)
- & write(iout,*)'s*>> structure rejected - same as nr ',i,
- & ' RMS',roznica
- minimize_s_flag=0
- icomp=0
- go to 1106
- endif
- endif
- if(energyx.lt.enetbss(i).and.enex_jp.lt.enetbss(i))then
- j=i
- enex_jp=enetbss(i)
- endif
- enddo
- if (iprint.gt.1) write(iout,*)
- if(nlist.gt.0) then
- if (modif) then
- if (iprint.gt.1)
- & write(iout,'(a,i3,$)')'s*>> structure accepted1 - repl nr ',
- & list(1)
- else
- if (iprint.gt.1)
- & write(iout,'(a,i3)')
- & 's*>> structure accepted1 - would repl nr ',list(1)
- endif
- icomp=9
- if (.not. modif) goto 1106
- j=list(1)
- enetbss(j)=energyx
- do i=1,nvar
- coordss(i,j)=x(i)
- enddo
- do j=2,nlist
- if (iprint.gt.1) write(iout,'(i3,$)')list(j)
- do kk=list(j)+1,nlist
- enetbss(kk-1)=enetbss(kk)
- do i=1,nvar
- coordss(i,kk-1)=coordss(i,kk)
- enddo
- enddo
- enddo
- if (iprint.gt.1) write(iout,*)
- go to 1106
- endif
- if(n_thr.lt.num_thread_save) then
- icomp=1
- if (modif) then
- if (iprint.gt.1)
- & write(iout,*)'s*>> structure accepted - add with nr ',n_thr+1
- else
- if (iprint.gt.1)
- & write(iout,*)'s*>> structure accepted - would add with nr ',
- & n_thr+1
- goto 1106
- endif
- n_thr=n_thr+1
- enetbss(n_thr)=energyx
- do i=1,nvar
- coordss(i,n_thr)=x(i)
- enddo
- else
- if(j.eq.0) then
- if (iprint.gt.1)
- & write(iout,*)'s*>> structure rejected - too high energy'
- icomp=2
- go to 1106
- end if
- icomp=3
- if (modif) then
- if (iprint.gt.1)
- & write(iout,*)'s*>> structure accepted - repl nr ',j
- else
- if (iprint.gt.1)
- & write(iout,*)'s*>> structure accepted - would repl nr ',j
- goto 1106
- endif
- enetbss(j)=energyx
- do i=1,nvar
- coordss(i,j)=x(i)
- enddo
- end if
-
-1106 continue
- return
- end
+++ /dev/null
-#include <stdio.h>
-#include <sys/utsname.h>
-#include <sys/types.h>
-#include <time.h>
-#include <string.h>
-
-main()
-{
-FILE *in, *in1, *out;
-int i,j,k,iv1,iv2,iv3;
-char *p1,buf[500],buf1[500],buf2[100],buf3[100];
-struct utsname Name;
-time_t Tp;
-
-in=fopen("cinfo.f","r");
-out=fopen("cinfo.f.new","w");
-if (fgets(buf,498,in) != NULL)
- fprintf(out,"C DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C\n");
-if (fgets(buf,498,in) != NULL)
- sscanf(&buf[1],"%d %d %d",&iv1,&iv2,&iv3);
-iv3++;
-fprintf(out,"C %d %d %d\n",iv1,iv2,iv3);
-fprintf(out," subroutine cinfo\n");
-fprintf(out," include 'COMMON.IOUNITS'\n");
-fprintf(out," write(iout,*)'++++ Compile info ++++'\n");
-fprintf(out," write(iout,*)'Version %d.%-d build %d'\n",iv1,iv2,iv3);
-uname(&Name);
-time(&Tp);
-system("whoami > tmptmp");
-in1=fopen("tmptmp","r");
-if (fscanf(in1,"%s",buf1) != EOF)
-{
-p1=ctime(&Tp);
-p1[strlen(p1)-1]='\0';
-fprintf(out," write(iout,*)'compiled %s'\n",p1);
-fprintf(out," write(iout,*)'compiled by %s@%s'\n",buf1,Name.nodename);
-fprintf(out," write(iout,*)'OS name: %s '\n",Name.sysname);
-fprintf(out," write(iout,*)'OS release: %s '\n",Name.release);
-fprintf(out," write(iout,*)'OS version:',\n");
-fprintf(out," & ' %s '\n",Name.version);
-fprintf(out," write(iout,*)'flags:'\n");
-}
-system("rm tmptmp");
-fclose(in1);
-in1=fopen("Makefile","r");
-while(fgets(buf,498,in1) != NULL)
- {
- if((p1=strchr(buf,'=')) != NULL && buf[0] != '#')
- {
- buf[strlen(buf)-1]='\0';
- if(strlen(buf) > 49)
- {
- buf[47]='\0';
- strcat(buf,"...");
- }
- else
- {
- while(buf[strlen(buf)-1]=='\\')
- {
- strcat(buf,"\\");
- fprintf(out," write(iout,*)'%s'\n",buf);
- if (fgets(buf,498,in1) != NULL)
- buf[strlen(buf)-1]='\0';
- if(strlen(buf) > 49)
- {
- buf[47]='\0';
- strcat(buf,"...");
- }
- }
- }
-
- fprintf(out," write(iout,*)'%s'\n",buf);
- }
- }
-fprintf(out," write(iout,*)'++++ End of compile info ++++'\n");
-fprintf(out," return\n");
-fprintf(out," end\n");
-fclose(out);
-fclose(in1);
-fclose(in);
-system("mv cinfo.f.new cinfo.f");
-}
+++ /dev/null
- subroutine contact(lprint,ncont,icont,co)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.NAMES'
- real*8 facont /1.569D0/ ! facont = (2/(1-sqrt(1-1/4)))**(1/6)
- integer ncont,icont(2,maxcont)
- logical lprint
- ncont=0
- kkk=3
- do i=nnt+kkk,nct
- iti=itype(i)
- do j=nnt,i-kkk
- itj=itype(j)
- if (ipot.ne.4) then
-c rcomp=sigmaii(iti,itj)+1.0D0
- rcomp=facont*sigmaii(iti,itj)
- else
-c rcomp=sigma(iti,itj)+1.0D0
- rcomp=facont*sigma(iti,itj)
- endif
-c rcomp=6.5D0
-c print *,'rcomp=',rcomp,' dist=',dist(nres+i,nres+j)
- if (dist(nres+i,nres+j).lt.rcomp) then
- ncont=ncont+1
- icont(1,ncont)=i
- icont(2,ncont)=j
- endif
- enddo
- enddo
- if (lprint) then
- write (iout,'(a)') 'Contact map:'
- do i=1,ncont
- i1=icont(1,i)
- i2=icont(2,i)
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(i3,2x,a,i4,2x,a,i4)')
- & i,restyp(it1),i1,restyp(it2),i2
- enddo
- endif
- co = 0.0d0
- do i=1,ncont
- co = co + dfloat(iabs(icont(1,i)-icont(2,i)))
- enddo
- co = co / (nres*ncont)
- return
- end
-c----------------------------------------------------------------------------
- double precision function contact_fract(ncont,ncont_ref,
- & icont,icont_ref)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont)
- nmatch=0
-c print *,'ncont=',ncont,' ncont_ref=',ncont_ref
-c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref)
-c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref)
-c write (iout,'(20i4)') (icont(1,i),i=1,ncont)
-c write (iout,'(20i4)') (icont(2,i),i=1,ncont)
- do i=1,ncont
- do j=1,ncont_ref
- if (icont(1,i).eq.icont_ref(1,j) .and.
- & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1
- enddo
- enddo
-c print *,' nmatch=',nmatch
-c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref))
- contact_fract=dfloat(nmatch)/dfloat(ncont_ref)
- return
- end
-c----------------------------------------------------------------------------
- double precision function contact_fract_nn(ncont,ncont_ref,
- & icont,icont_ref)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont)
- nmatch=0
-c print *,'ncont=',ncont,' ncont_ref=',ncont_ref
-c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref)
-c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref)
-c write (iout,'(20i4)') (icont(1,i),i=1,ncont)
-c write (iout,'(20i4)') (icont(2,i),i=1,ncont)
- do i=1,ncont
- do j=1,ncont_ref
- if (icont(1,i).eq.icont_ref(1,j) .and.
- & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1
- enddo
- enddo
-c print *,' nmatch=',nmatch
-c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref))
- contact_fract_nn=dfloat(ncont-nmatch)/dfloat(ncont)
- return
- end
-c----------------------------------------------------------------------------
- subroutine hairpin(lprint,nharp,iharp)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.NAMES'
- integer ncont,icont(2,maxcont)
- integer nharp,iharp(4,maxres/3)
- logical lprint,not_done
- real*8 rcomp /6.0d0/
- ncont=0
- kkk=0
-c print *,'nnt=',nnt,' nct=',nct
- do i=nnt,nct-3
- do k=1,3
- c(k,2*nres+1)=0.5d0*(c(k,i)+c(k,i+1))
- enddo
- do j=i+2,nct-1
- do k=1,3
- c(k,2*nres+2)=0.5d0*(c(k,j)+c(k,j+1))
- enddo
- if (dist(2*nres+1,2*nres+2).lt.rcomp) then
- ncont=ncont+1
- icont(1,ncont)=i
- icont(2,ncont)=j
- endif
- enddo
- enddo
- if (lprint) then
- write (iout,'(a)') 'PP contact map:'
- do i=1,ncont
- i1=icont(1,i)
- i2=icont(2,i)
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(i3,2x,a,i4,2x,a,i4)')
- & i,restyp(it1),i1,restyp(it2),i2
- enddo
- endif
-c finding hairpins
- nharp=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (j1.eq.i1+2 .and. i1.gt.nnt .and. j1.lt.nct) then
-c write (iout,*) "found turn at ",i1,j1
- ii1=i1
- jj1=j1
- not_done=.true.
- do while (not_done)
- i1=i1-1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10
- enddo
- not_done=.false.
- 10 continue
-c write (iout,*) i1,j1,not_done
- enddo
- i1=i1+1
- j1=j1-1
- if (j1-i1.gt.4) then
- nharp=nharp+1
- iharp(1,nharp)=i1
- iharp(2,nharp)=j1
- iharp(3,nharp)=ii1
- iharp(4,nharp)=jj1
-c write (iout,*)'nharp',nharp,' iharp',(iharp(k,nharp),k=1,4)
- endif
- endif
- enddo
-c do i=1,nharp
-c write (iout,*)'i',i,' iharp',(iharp(k,i),k=1,4)
-c enddo
- if (lprint) then
- write (iout,*) "Hairpins:"
- do i=1,nharp
- i1=iharp(1,i)
- j1=iharp(2,i)
- ii1=iharp(3,i)
- jj1=iharp(4,i)
- write (iout,*)
- write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=i1,ii1)
- write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=j1,jj1,-1)
-c do k=jj1,j1,-1
-c write (iout,'(a,i3,$)') restyp(itype(k)),k
-c enddo
- enddo
- endif
- return
- end
-c----------------------------------------------------------------------------
-
+++ /dev/null
- subroutine geom_to_var(n,x)
-C
-C Transfer the geometry parameters to the variable array.
-C The positions of variables are as follows:
-C 1. Virtual-bond torsional angles: 1 thru nres-3
-C 2. Virtual-bond valence angles: nres-2 thru 2*nres-5
-C 3. The polar angles alpha of local SC orientation: 2*nres-4 thru
-C 2*nres-4+nside
-C 4. The torsional angles omega of SC orientation: 2*nres-4+nside+1
-C thru 2*nre-4+2*nside
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- double precision x(n)
-cd print *,'nres',nres,' nphi',nphi,' ntheta',ntheta,' nvar',nvar
- do i=4,nres
- x(i-3)=phi(i)
-cd print *,i,i-3,phi(i)
- enddo
- if (n.eq.nphi) return
- do i=3,nres
- x(i-2+nphi)=theta(i)
-cd print *,i,i-2+nphi,theta(i)
- enddo
- if (n.eq.nphi+ntheta) return
- do i=2,nres-1
- if (ialph(i,1).gt.0) then
- x(ialph(i,1))=alph(i)
- x(ialph(i,1)+nside)=omeg(i)
-cd print *,i,ialph(i,1),ialph(i,1)+nside,alph(i),omeg(i)
- endif
- enddo
- return
- end
-C--------------------------------------------------------------------
- subroutine var_to_geom(n,x)
-C
-C Update geometry parameters according to the variable array.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.IOUNITS'
- dimension x(n)
- logical change,reduce
- change=reduce(x)
- if (n.gt.nphi+ntheta) then
- do i=1,nside
- ii=ialph(i,2)
- alph(ii)=x(nphi+ntheta+i)
- omeg(ii)=pinorm(x(nphi+ntheta+nside+i))
- enddo
- endif
- do i=4,nres
- phi(i)=x(i-3)
- enddo
- if (n.eq.nphi) return
- do i=3,nres
- theta(i)=x(i-2+nphi)
- if (theta(i).eq.pi) theta(i)=0.99d0*pi
- x(i-2+nphi)=theta(i)
- enddo
- return
- end
-c-------------------------------------------------------------------------
- logical function convert_side(alphi,omegi)
- implicit none
- double precision alphi,omegi
- double precision pinorm
- include 'COMMON.GEO'
- convert_side=.false.
-C Apply periodicity restrictions.
- if (alphi.gt.pi) then
- alphi=dwapi-alphi
- omegi=pinorm(omegi+pi)
- convert_side=.true.
- endif
- return
- end
-c-------------------------------------------------------------------------
- logical function reduce(x)
-C
-C Apply periodic restrictions to variables.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- logical zm,zmiana,convert_side
- dimension x(nvar)
- zmiana=.false.
- do i=4,nres
- x(i-3)=pinorm(x(i-3))
- enddo
- if (nvar.gt.nphi+ntheta) then
- do i=1,nside
- ii=nphi+ntheta+i
- iii=ii+nside
- x(ii)=thetnorm(x(ii))
- x(iii)=pinorm(x(iii))
-C Apply periodic restrictions.
- zm=convert_side(x(ii),x(iii))
- zmiana=zmiana.or.zm
- enddo
- endif
- if (nvar.eq.nphi) return
- do i=3,nres
- ii=i-2+nphi
- iii=i-3
- x(ii)=dmod(x(ii),dwapi)
-C Apply periodic restrictions.
- if (x(ii).gt.pi) then
- zmiana=.true.
- x(ii)=dwapi-x(ii)
- if (iii.gt.0) x(iii)=pinorm(x(iii)+pi)
- if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi)
- ii=ialph(i-1,1)
- if (ii.gt.0) then
- x(ii)=dmod(pi-x(ii),dwapi)
- x(ii+nside)=pinorm(-x(ii+nside))
- zm=convert_side(x(ii),x(ii+nside))
- endif
- else if (x(ii).lt.-pi) then
- zmiana=.true.
- x(ii)=dwapi+x(ii)
- ii=ialph(i-1,1)
- if (ii.gt.0) then
- x(ii)=dmod(pi-x(ii),dwapi)
- x(ii+nside)=pinorm(-pi-x(ii+nside))
- zm=convert_side(x(ii),x(ii+nside))
- endif
- else if (x(ii).lt.0.0d0) then
- zmiana=.true.
- x(ii)=-x(ii)
- if (iii.gt.0) x(iii)=pinorm(x(iii)+pi)
- if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi)
- ii=ialph(i-1,1)
- if (ii.gt.0) then
- x(ii+nside)=pinorm(-x(ii+nside))
- zm=convert_side(x(ii),x(ii+nside))
- endif
- endif
- enddo
- reduce=zmiana
- return
- end
-c--------------------------------------------------------------------------
- double precision function thetnorm(x)
-C This function puts x within [0,2Pi].
- implicit none
- double precision x,xx
- include 'COMMON.GEO'
- xx=dmod(x,dwapi)
- if (xx.lt.0.0d0) xx=xx+dwapi
- if (xx.gt.0.9999d0*pi) xx=0.9999d0*pi
- thetnorm=xx
- return
- end
-C--------------------------------------------------------------------
- subroutine var_to_geom_restr(n,xx)
-C
-C Update geometry parameters according to the variable array.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.IOUNITS'
- dimension x(maxvar),xx(maxvar)
- logical change,reduce
-
- call xx2x(x,xx)
- change=reduce(x)
- do i=1,nside
- ii=ialph(i,2)
- alph(ii)=x(nphi+ntheta+i)
- omeg(ii)=pinorm(x(nphi+ntheta+nside+i))
- enddo
- do i=4,nres
- phi(i)=x(i-3)
- enddo
- do i=3,nres
- theta(i)=x(i-2+nphi)
- if (theta(i).eq.pi) theta(i)=0.99d0*pi
- x(i-2+nphi)=theta(i)
- enddo
- return
- end
-c-------------------------------------------------------------------------
+++ /dev/null
- subroutine assst(iv, liv, lv, v)
-c
-c *** assess candidate step (***sol version 2.3) ***
-c
- integer liv, l
- integer iv(liv)
- double precision v(lv)
-c
-c *** purpose ***
-c
-c this subroutine is called by an unconstrained minimization
-c routine to assess the next candidate step. it may recommend one
-c of several courses of action, such as accepting the step, recom-
-c puting it using the same or a new quadratic model, or halting due
-c to convergence or false convergence. see the return code listing
-c below.
-c
-c-------------------------- parameter usage --------------------------
-c
-c iv (i/o) integer parameter and scratch vector -- see description
-c below of iv values referenced.
-c liv (in) length of iv array.
-c lv (in) length of v array.
-c v (i/o) real parameter and scratch vector -- see description
-c below of v values referenced.
-c
-c *** iv values referenced ***
-c
-c iv(irc) (i/o) on input for the first step tried in a new iteration,
-c iv(irc) should be set to 3 or 4 (the value to which it is
-c set when step is definitely to be accepted). on input
-c after step has been recomputed, iv(irc) should be
-c unchanged since the previous return of assst.
-c on output, iv(irc) is a return code having one of the
-c following values...
-c 1 = switch models or try smaller step.
-c 2 = switch models or accept step.
-c 3 = accept step and determine v(radfac) by gradient
-c tests.
-c 4 = accept step, v(radfac) has been determined.
-c 5 = recompute step (using the same model).
-c 6 = recompute step with radius = v(lmaxs) but do not
-c evaulate the objective function.
-c 7 = x-convergence (see v(xctol)).
-c 8 = relative function convergence (see v(rfctol)).
-c 9 = both x- and relative function convergence.
-c 10 = absolute function convergence (see v(afctol)).
-c 11 = singular convergence (see v(lmaxs)).
-c 12 = false convergence (see v(xftol)).
-c 13 = iv(irc) was out of range on input.
-c return code i has precdence over i+1 for i = 9, 10, 11.
-c iv(mlstgd) (i/o) saved value of iv(model).
-c iv(model) (i/o) on input, iv(model) should be an integer identifying
-c the current quadratic model of the objective function.
-c if a previous step yielded a better function reduction,
-c then iv(model) will be set to iv(mlstgd) on output.
-c iv(nfcall) (in) invocation count for the objective function.
-c iv(nfgcal) (i/o) value of iv(nfcall) at step that gave the biggest
-c function reduction this iteration. iv(nfgcal) remains
-c unchanged until a function reduction is obtained.
-c iv(radinc) (i/o) the number of radius increases (or minus the number
-c of decreases) so far this iteration.
-c iv(restor) (out) set to 1 if v(f) has been restored and x should be
-c restored to its initial value, to 2 if x should be saved,
-c to 3 if x should be restored from the saved value, and to
-c 0 otherwise.
-c iv(stage) (i/o) count of the number of models tried so far in the
-c current iteration.
-c iv(stglim) (in) maximum number of models to consider.
-c iv(switch) (out) set to 0 unless a new model is being tried and it
-c gives a smaller function value than the previous model,
-c in which case assst sets iv(switch) = 1.
-c iv(toobig) (in) is nonzero if step was too big (e.g. if it caused
-c overflow).
-c iv(xirc) (i/o) value that iv(irc) would have in the absence of
-c convergence, false convergence, and oversized steps.
-c
-c *** v values referenced ***
-c
-c v(afctol) (in) absolute function convergence tolerance. if the
-c absolute value of the current function value v(f) is less
-c than v(afctol), then assst returns with iv(irc) = 10.
-c v(decfac) (in) factor by which to decrease radius when iv(toobig) is
-c nonzero.
-c v(dstnrm) (in) the 2-norm of d*step.
-c v(dstsav) (i/o) value of v(dstnrm) on saved step.
-c v(dst0) (in) the 2-norm of d times the newton step (when defined,
-c i.e., for v(nreduc) .ge. 0).
-c v(f) (i/o) on both input and output, v(f) is the objective func-
-c tion value at x. if x is restored to a previous value,
-c then v(f) is restored to the corresponding value.
-c v(fdif) (out) the function reduction v(f0) - v(f) (for the output
-c value of v(f) if an earlier step gave a bigger function
-c decrease, and for the input value of v(f) otherwise).
-c v(flstgd) (i/o) saved value of v(f).
-c v(f0) (in) objective function value at start of iteration.
-c v(gtslst) (i/o) value of v(gtstep) on saved step.
-c v(gtstep) (in) inner product between step and gradient.
-c v(incfac) (in) minimum factor by which to increase radius.
-c v(lmaxs) (in) maximum reasonable step size (and initial step bound).
-c if the actual function decrease is no more than twice
-c what was predicted, if a return with iv(irc) = 7, 8, 9,
-c or 10 does not occur, if v(dstnrm) .gt. v(lmaxs), and if
-c v(preduc) .le. v(sctol) * abs(v(f0)), then assst re-
-c turns with iv(irc) = 11. if so doing appears worthwhile,
-c then assst repeats this test with v(preduc) computed for
-c a step of length v(lmaxs) (by a return with iv(irc) = 6).
-c v(nreduc) (i/o) function reduction predicted by quadratic model for
-c newton step. if assst is called with iv(irc) = 6, i.e.,
-c if v(preduc) has been computed with radius = v(lmaxs) for
-c use in the singular convervence test, then v(nreduc) is
-c set to -v(preduc) before the latter is restored.
-c v(plstgd) (i/o) value of v(preduc) on saved step.
-c v(preduc) (i/o) function reduction predicted by quadratic model for
-c current step.
-c v(radfac) (out) factor to be used in determining the new radius,
-c which should be v(radfac)*dst, where dst is either the
-c output value of v(dstnrm) or the 2-norm of
-c diag(newd)*step for the output value of step and the
-c updated version, newd, of the scale vector d. for
-c iv(irc) = 3, v(radfac) = 1.0 is returned.
-c v(rdfcmn) (in) minimum value for v(radfac) in terms of the input
-c value of v(dstnrm) -- suggested value = 0.1.
-c v(rdfcmx) (in) maximum value for v(radfac) -- suggested value = 4.0.
-c v(reldx) (in) scaled relative change in x caused by step, computed
-c (e.g.) by function reldst as
-c max (d(i)*abs(x(i)-x0(i)), 1 .le. i .le. p) /
-c max (d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p).
-c v(rfctol) (in) relative function convergence tolerance. if the
-c actual function reduction is at most twice what was pre-
-c dicted and v(nreduc) .le. v(rfctol)*abs(v(f0)), then
-c assst returns with iv(irc) = 8 or 9.
-c v(stppar) (in) marquardt parameter -- 0 means full newton step.
-c v(tuner1) (in) tuning constant used to decide if the function
-c reduction was much less than expected. suggested
-c value = 0.1.
-c v(tuner2) (in) tuning constant used to decide if the function
-c reduction was large enough to accept step. suggested
-c value = 10**-4.
-c v(tuner3) (in) tuning constant used to decide if the radius
-c should be increased. suggested value = 0.75.
-c v(xctol) (in) x-convergence criterion. if step is a newton step
-c (v(stppar) = 0) having v(reldx) .le. v(xctol) and giving
-c at most twice the predicted function decrease, then
-c assst returns iv(irc) = 7 or 9.
-c v(xftol) (in) false convergence tolerance. if step gave no or only
-c a small function decrease and v(reldx) .le. v(xftol),
-c then assst returns with iv(irc) = 12.
-c
-c------------------------------- notes -------------------------------
-c
-c *** application and usage restrictions ***
-c
-c this routine is called as part of the nl2sol (nonlinear
-c least-squares) package. it may be used in any unconstrained
-c minimization solver that uses dogleg, goldfeld-quandt-trotter,
-c or levenberg-marquardt steps.
-c
-c *** algorithm notes ***
-c
-c see (1) for further discussion of the assessing and model
-c switching strategies. while nl2sol considers only two models,
-c assst is designed to handle any number of models.
-c
-c *** usage notes ***
-c
-c on the first call of an iteration, only the i/o variables
-c step, x, iv(irc), iv(model), v(f), v(dstnrm), v(gtstep), and
-c v(preduc) need have been initialized. between calls, no i/o
-c values execpt step, x, iv(model), v(f) and the stopping toler-
-c ances should be changed.
-c after a return for convergence or false convergence, one can
-c change the stopping tolerances and call assst again, in which
-c case the stopping tests will be repeated.
-c
-c *** references ***
-c
-c (1) dennis, j.e., jr., gay, d.m., and welsch, r.e. (1981),
-c an adaptive nonlinear least-squares algorithm,
-c acm trans. math. software, vol. 7, no. 3.
-c
-c (2) powell, m.j.d. (1970) a fortran subroutine for solving
-c systems of nonlinear algebraic equations, in numerical
-c methods for nonlinear algebraic equations, edited by
-c p. rabinowitz, gordon and breach, london.
-c
-c *** history ***
-c
-c john dennis designed much of this routine, starting with
-c ideas in (2). roy welsch suggested the model switching strategy.
-c david gay and stephen peters cast this subroutine into a more
-c portable form (winter 1977), and david gay cast it into its
-c present form (fall 1978).
-c
-c *** general ***
-c
-c this subroutine was written in connection with research
-c supported by the national science foundation under grants
-c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and
-c mcs-7906671.
-c
-c------------------------ external quantities ------------------------
-c
-c *** no external functions and subroutines ***
-c
-c *** intrinsic functions ***
-c/+
- double precision dabs, dmax1
-c/
-c *** no common blocks ***
-c
-c-------------------------- local variables --------------------------
-c
- logical goodx
- integer i, nfc
- double precision emax, emaxs, gts, rfac1, xmax
- double precision half, one, onep2, two, zero
-c
-c *** subscripts for iv and v ***
-c
- integer afctol, decfac, dstnrm, dstsav, dst0, f, fdif, flstgd, f0,
- 1 gtslst, gtstep, incfac, irc, lmaxs, mlstgd, model, nfcall,
- 2 nfgcal, nreduc, plstgd, preduc, radfac, radinc, rdfcmn,
- 3 rdfcmx, reldx, restor, rfctol, sctol, stage, stglim,
- 4 stppar, switch, toobig, tuner1, tuner2, tuner3, xctol,
- 5 xftol, xirc
-c
-c *** data initializations ***
-c
-c/6
-c data half/0.5d+0/, one/1.d+0/, onep2/1.2d+0/, two/2.d+0/,
-c 1 zero/0.d+0/
-c/7
- parameter (half=0.5d+0, one=1.d+0, onep2=1.2d+0, two=2.d+0,
- 1 zero=0.d+0)
-c/
-c
-c/6
-c data irc/29/, mlstgd/32/, model/5/, nfcall/6/, nfgcal/7/,
-c 1 radinc/8/, restor/9/, stage/10/, stglim/11/, switch/12/,
-c 2 toobig/2/, xirc/13/
-c/7
- parameter (irc=29, mlstgd=32, model=5, nfcall=6, nfgcal=7,
- 1 radinc=8, restor=9, stage=10, stglim=11, switch=12,
- 2 toobig=2, xirc=13)
-c/
-c/6
-c data afctol/31/, decfac/22/, dstnrm/2/, dst0/3/, dstsav/18/,
-c 1 f/10/, fdif/11/, flstgd/12/, f0/13/, gtslst/14/, gtstep/4/,
-c 2 incfac/23/, lmaxs/36/, nreduc/6/, plstgd/15/, preduc/7/,
-c 3 radfac/16/, rdfcmn/24/, rdfcmx/25/, reldx/17/, rfctol/32/,
-c 4 sctol/37/, stppar/5/, tuner1/26/, tuner2/27/, tuner3/28/,
-c 5 xctol/33/, xftol/34/
-c/7
- parameter (afctol=31, decfac=22, dstnrm=2, dst0=3, dstsav=18,
- 1 f=10, fdif=11, flstgd=12, f0=13, gtslst=14, gtstep=4,
- 2 incfac=23, lmaxs=36, nreduc=6, plstgd=15, preduc=7,
- 3 radfac=16, rdfcmn=24, rdfcmx=25, reldx=17, rfctol=32,
- 4 sctol=37, stppar=5, tuner1=26, tuner2=27, tuner3=28,
- 5 xctol=33, xftol=34)
-c/
-c
-c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++
-c
- nfc = iv(nfcall)
- iv(switch) = 0
- iv(restor) = 0
- rfac1 = one
- goodx = .true.
- i = iv(irc)
- if (i .ge. 1 .and. i .le. 12)
- 1 go to (20,30,10,10,40,280,220,220,220,220,220,170), i
- iv(irc) = 13
- go to 999
-c
-c *** initialize for new iteration ***
-c
- 10 iv(stage) = 1
- iv(radinc) = 0
- v(flstgd) = v(f0)
- if (iv(toobig) .eq. 0) go to 110
- iv(stage) = -1
- iv(xirc) = i
- go to 60
-c
-c *** step was recomputed with new model or smaller radius ***
-c *** first decide which ***
-c
- 20 if (iv(model) .ne. iv(mlstgd)) go to 30
-c *** old model retained, smaller radius tried ***
-c *** do not consider any more new models this iteration ***
- iv(stage) = iv(stglim)
- iv(radinc) = -1
- go to 110
-c
-c *** a new model is being tried. decide whether to keep it. ***
-c
- 30 iv(stage) = iv(stage) + 1
-c
-c *** now we add the possibiltiy that step was recomputed with ***
-c *** the same model, perhaps because of an oversized step. ***
-c
- 40 if (iv(stage) .gt. 0) go to 50
-c
-c *** step was recomputed because it was too big. ***
-c
- if (iv(toobig) .ne. 0) go to 60
-c
-c *** restore iv(stage) and pick up where we left off. ***
-c
- iv(stage) = -iv(stage)
- i = iv(xirc)
- go to (20, 30, 110, 110, 70), i
-c
- 50 if (iv(toobig) .eq. 0) go to 70
-c
-c *** handle oversize step ***
-c
- if (iv(radinc) .gt. 0) go to 80
- iv(stage) = -iv(stage)
- iv(xirc) = iv(irc)
-c
- 60 v(radfac) = v(decfac)
- iv(radinc) = iv(radinc) - 1
- iv(irc) = 5
- iv(restor) = 1
- go to 999
-c
- 70 if (v(f) .lt. v(flstgd)) go to 110
-c
-c *** the new step is a loser. restore old model. ***
-c
- if (iv(model) .eq. iv(mlstgd)) go to 80
- iv(model) = iv(mlstgd)
- iv(switch) = 1
-c
-c *** restore step, etc. only if a previous step decreased v(f).
-c
- 80 if (v(flstgd) .ge. v(f0)) go to 110
- iv(restor) = 1
- v(f) = v(flstgd)
- v(preduc) = v(plstgd)
- v(gtstep) = v(gtslst)
- if (iv(switch) .eq. 0) rfac1 = v(dstnrm) / v(dstsav)
- v(dstnrm) = v(dstsav)
- nfc = iv(nfgcal)
- goodx = .false.
-c
- 110 v(fdif) = v(f0) - v(f)
- if (v(fdif) .gt. v(tuner2) * v(preduc)) go to 140
- if(iv(radinc).gt.0) go to 140
-c
-c *** no (or only a trivial) function decrease
-c *** -- so try new model or smaller radius
-c
- if (v(f) .lt. v(f0)) go to 120
- iv(mlstgd) = iv(model)
- v(flstgd) = v(f)
- v(f) = v(f0)
- iv(restor) = 1
- go to 130
- 120 iv(nfgcal) = nfc
- 130 iv(irc) = 1
- if (iv(stage) .lt. iv(stglim)) go to 160
- iv(irc) = 5
- iv(radinc) = iv(radinc) - 1
- go to 160
-c
-c *** nontrivial function decrease achieved ***
-c
- 140 iv(nfgcal) = nfc
- rfac1 = one
- v(dstsav) = v(dstnrm)
- if (v(fdif) .gt. v(preduc)*v(tuner1)) go to 190
-c
-c *** decrease was much less than predicted -- either change models
-c *** or accept step with decreased radius.
-c
- if (iv(stage) .ge. iv(stglim)) go to 150
-c *** consider switching models ***
- iv(irc) = 2
- go to 160
-c
-c *** accept step with decreased radius ***
-c
- 150 iv(irc) = 4
-c
-c *** set v(radfac) to fletcher*s decrease factor ***
-c
- 160 iv(xirc) = iv(irc)
- emax = v(gtstep) + v(fdif)
- v(radfac) = half * rfac1
- if (emax .lt. v(gtstep)) v(radfac) = rfac1 * dmax1(v(rdfcmn),
- 1 half * v(gtstep)/emax)
-c
-c *** do false convergence test ***
-c
- 170 if (v(reldx) .le. v(xftol)) go to 180
- iv(irc) = iv(xirc)
- if (v(f) .lt. v(f0)) go to 200
- go to 230
-c
- 180 iv(irc) = 12
- go to 240
-c
-c *** handle good function decrease ***
-c
- 190 if (v(fdif) .lt. (-v(tuner3) * v(gtstep))) go to 210
-c
-c *** increasing radius looks worthwhile. see if we just
-c *** recomputed step with a decreased radius or restored step
-c *** after recomputing it with a larger radius.
-c
- if (iv(radinc) .lt. 0) go to 210
- if (iv(restor) .eq. 1) go to 210
-c
-c *** we did not. try a longer step unless this was a newton
-c *** step.
-c
- v(radfac) = v(rdfcmx)
- gts = v(gtstep)
- if (v(fdif) .lt. (half/v(radfac) - one) * gts)
- 1 v(radfac) = dmax1(v(incfac), half*gts/(gts + v(fdif)))
- iv(irc) = 4
- if (v(stppar) .eq. zero) go to 230
- if (v(dst0) .ge. zero .and. (v(dst0) .lt. two*v(dstnrm)
- 1 .or. v(nreduc) .lt. onep2*v(fdif))) go to 230
-c *** step was not a newton step. recompute it with
-c *** a larger radius.
- iv(irc) = 5
- iv(radinc) = iv(radinc) + 1
-c
-c *** save values corresponding to good step ***
-c
- 200 v(flstgd) = v(f)
- iv(mlstgd) = iv(model)
- if (iv(restor) .ne. 1) iv(restor) = 2
- v(dstsav) = v(dstnrm)
- iv(nfgcal) = nfc
- v(plstgd) = v(preduc)
- v(gtslst) = v(gtstep)
- go to 230
-c
-c *** accept step with radius unchanged ***
-c
- 210 v(radfac) = one
- iv(irc) = 3
- go to 230
-c
-c *** come here for a restart after convergence ***
-c
- 220 iv(irc) = iv(xirc)
- if (v(dstsav) .ge. zero) go to 240
- iv(irc) = 12
- go to 240
-c
-c *** perform convergence tests ***
-c
- 230 iv(xirc) = iv(irc)
- 240 if (iv(restor) .eq. 1 .and. v(flstgd) .lt. v(f0)) iv(restor) = 3
- if (half * v(fdif) .gt. v(preduc)) go to 999
- emax = v(rfctol) * dabs(v(f0))
- emaxs = v(sctol) * dabs(v(f0))
- if (v(dstnrm) .gt. v(lmaxs) .and. v(preduc) .le. emaxs)
- 1 iv(irc) = 11
- if (v(dst0) .lt. zero) go to 250
- i = 0
- if ((v(nreduc) .gt. zero .and. v(nreduc) .le. emax) .or.
- 1 (v(nreduc) .eq. zero. and. v(preduc) .eq. zero)) i = 2
- if (v(stppar) .eq. zero .and. v(reldx) .le. v(xctol)
- 1 .and. goodx) i = i + 1
- if (i .gt. 0) iv(irc) = i + 6
-c
-c *** consider recomputing step of length v(lmaxs) for singular
-c *** convergence test.
-c
- 250 if (iv(irc) .gt. 5 .and. iv(irc) .ne. 12) go to 999
- if (v(dstnrm) .gt. v(lmaxs)) go to 260
- if (v(preduc) .ge. emaxs) go to 999
- if (v(dst0) .le. zero) go to 270
- if (half * v(dst0) .le. v(lmaxs)) go to 999
- go to 270
- 260 if (half * v(dstnrm) .le. v(lmaxs)) go to 999
- xmax = v(lmaxs) / v(dstnrm)
- if (xmax * (two - xmax) * v(preduc) .ge. emaxs) go to 999
- 270 if (v(nreduc) .lt. zero) go to 290
-c
-c *** recompute v(preduc) for use in singular convergence test ***
-c
- v(gtslst) = v(gtstep)
- v(dstsav) = v(dstnrm)
- if (iv(irc) .eq. 12) v(dstsav) = -v(dstsav)
- v(plstgd) = v(preduc)
- i = iv(restor)
- iv(restor) = 2
- if (i .eq. 3) iv(restor) = 0
- iv(irc) = 6
- go to 999
-c
-c *** perform singular convergence test with recomputed v(preduc) ***
-c
- 280 v(gtstep) = v(gtslst)
- v(dstnrm) = dabs(v(dstsav))
- iv(irc) = iv(xirc)
- if (v(dstsav) .le. zero) iv(irc) = 12
- v(nreduc) = -v(preduc)
- v(preduc) = v(plstgd)
- iv(restor) = 3
- 290 if (-v(nreduc) .le. v(sctol) * dabs(v(f0))) iv(irc) = 11
-c
- 999 return
-c
-c *** last card of assst follows ***
- end
- subroutine deflt(alg, iv, liv, lv, v)
-c
-c *** supply ***sol (version 2.3) default values to iv and v ***
-c
-c *** alg = 1 means regression constants.
-c *** alg = 2 means general unconstrained optimization constants.
-c
- integer liv, l
- integer alg, iv(liv)
- double precision v(lv)
-c
- external imdcon, vdflt
- integer imdcon
-c imdcon... returns machine-dependent integer constants.
-c vdflt.... provides default values to v.
-c
- integer miv, m
- integer miniv(2), minv(2)
-c
-c *** subscripts for iv ***
-c
- integer algsav, covprt, covreq, dtype, hc, ierr, inith, inits,
- 1 ipivot, ivneed, lastiv, lastv, lmat, mxfcal, mxiter,
- 2 nfcov, ngcov, nvdflt, outlev, parprt, parsav, perm,
- 3 prunit, qrtyp, rdreq, rmat, solprt, statpr, vneed,
- 4 vsave, x0prt
-c
-c *** iv subscript values ***
-c
-c/6
-c data algsav/51/, covprt/14/, covreq/15/, dtype/16/, hc/71/,
-c 1 ierr/75/, inith/25/, inits/25/, ipivot/76/, ivneed/3/,
-c 2 lastiv/44/, lastv/45/, lmat/42/, mxfcal/17/, mxiter/18/,
-c 3 nfcov/52/, ngcov/53/, nvdflt/50/, outlev/19/, parprt/20/,
-c 4 parsav/49/, perm/58/, prunit/21/, qrtyp/80/, rdreq/57/,
-c 5 rmat/78/, solprt/22/, statpr/23/, vneed/4/, vsave/60/,
-c 6 x0prt/24/
-c/7
- parameter (algsav=51, covprt=14, covreq=15, dtype=16, hc=71,
- 1 ierr=75, inith=25, inits=25, ipivot=76, ivneed=3,
- 2 lastiv=44, lastv=45, lmat=42, mxfcal=17, mxiter=18,
- 3 nfcov=52, ngcov=53, nvdflt=50, outlev=19, parprt=20,
- 4 parsav=49, perm=58, prunit=21, qrtyp=80, rdreq=57,
- 5 rmat=78, solprt=22, statpr=23, vneed=4, vsave=60,
- 6 x0prt=24)
-c/
- data miniv(1)/80/, miniv(2)/59/, minv(1)/98/, minv(2)/71/
-c
-c------------------------------- body --------------------------------
-c
- if (alg .lt. 1 .or. alg .gt. 2) go to 40
- miv = miniv(alg)
- if (liv .lt. miv) go to 20
- mv = minv(alg)
- if (lv .lt. mv) go to 30
- call vdflt(alg, lv, v)
- iv(1) = 12
- iv(algsav) = alg
- iv(ivneed) = 0
- iv(lastiv) = miv
- iv(lastv) = mv
- iv(lmat) = mv + 1
- iv(mxfcal) = 200
- iv(mxiter) = 150
- iv(outlev) = 1
- iv(parprt) = 1
- iv(perm) = miv + 1
- iv(prunit) = imdcon(1)
- iv(solprt) = 1
- iv(statpr) = 1
- iv(vneed) = 0
- iv(x0prt) = 1
-c
- if (alg .ge. 2) go to 10
-c
-c *** regression values
-c
- iv(covprt) = 3
- iv(covreq) = 1
- iv(dtype) = 1
- iv(hc) = 0
- iv(ierr) = 0
- iv(inits) = 0
- iv(ipivot) = 0
- iv(nvdflt) = 32
- iv(parsav) = 67
- iv(qrtyp) = 1
- iv(rdreq) = 3
- iv(rmat) = 0
- iv(vsave) = 58
- go to 999
-c
-c *** general optimization values
-c
- 10 iv(dtype) = 0
- iv(inith) = 1
- iv(nfcov) = 0
- iv(ngcov) = 0
- iv(nvdflt) = 25
- iv(parsav) = 47
- go to 999
-c
- 20 iv(1) = 15
- go to 999
-c
- 30 iv(1) = 16
- go to 999
-c
- 40 iv(1) = 67
-c
- 999 return
-c *** last card of deflt follows ***
- end
- double precision function dotprd(p, x, y)
-c
-c *** return the inner product of the p-vectors x and y. ***
-c
- integer p
- double precision x(p), y(p)
-c
- integer i
- double precision one, sqteta, t, zero
-c/+
- double precision dmax1, dabs
-c/
- external rmdcon
- double precision rmdcon
-c
-c *** rmdcon(2) returns a machine-dependent constant, sqteta, which
-c *** is slightly larger than the smallest positive number that
-c *** can be squared without underflowing.
-c
-c/6
-c data one/1.d+0/, sqteta/0.d+0/, zero/0.d+0/
-c/7
- parameter (one=1.d+0, zero=0.d+0)
- data sqteta/0.d+0/
-c/
-c
- dotprd = zero
- if (p .le. 0) go to 999
-crc if (sqteta .eq. zero) sqteta = rmdcon(2)
- do 20 i = 1, p
-crc t = dmax1(dabs(x(i)), dabs(y(i)))
-crc if (t .gt. one) go to 10
-crc if (t .lt. sqteta) go to 20
-crc t = (x(i)/sqteta)*y(i)
-crc if (dabs(t) .lt. sqteta) go to 20
- 10 dotprd = dotprd + x(i)*y(i)
- 20 continue
-c
- 999 return
-c *** last card of dotprd follows ***
- end
- subroutine itsum(d, g, iv, liv, lv, p, v, x)
-c
-c *** print iteration summary for ***sol (version 2.3) ***
-c
-c *** parameter declarations ***
-c
- integer liv, lv, p
- integer iv(liv)
- double precision d(p), g(p), v(lv), x(p)
-c
-c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-c
-c *** local variables ***
-c
- integer alg, i, iv1, m, nf, ng, ol, pu
-c/6
-c real model1(6), model2(6)
-c/7
- character*4 model1(6), model2(6)
-c/
- double precision nreldf, oldf, preldf, reldf, zero
-c
-c *** intrinsic functions ***
-c/+
- integer iabs
- double precision dabs, dmax1
-c/
-c *** no external functions or subroutines ***
-c
-c *** subscripts for iv and v ***
-c
- integer algsav, dstnrm, f, fdif, f0, needhd, nfcall, nfcov, ngcov,
- 1 ngcall, niter, nreduc, outlev, preduc, prntit, prunit,
- 2 reldx, solprt, statpr, stppar, sused, x0prt
-c
-c *** iv subscript values ***
-c
-c/6
-c data algsav/51/, needhd/36/, nfcall/6/, nfcov/52/, ngcall/30/,
-c 1 ngcov/53/, niter/31/, outlev/19/, prntit/39/, prunit/21/,
-c 2 solprt/22/, statpr/23/, sused/64/, x0prt/24/
-c/7
- parameter (algsav=51, needhd=36, nfcall=6, nfcov=52, ngcall=30,
- 1 ngcov=53, niter=31, outlev=19, prntit=39, prunit=21,
- 2 solprt=22, statpr=23, sused=64, x0prt=24)
-c/
-c
-c *** v subscript values ***
-c
-c/6
-c data dstnrm/2/, f/10/, f0/13/, fdif/11/, nreduc/6/, preduc/7/,
-c 1 reldx/17/, stppar/5/
-c/7
- parameter (dstnrm=2, f=10, f0=13, fdif=11, nreduc=6, preduc=7,
- 1 reldx=17, stppar=5)
-c/
-c
-c/6
-c data zero/0.d+0/
-c/7
- parameter (zero=0.d+0)
-c/
-c/6
-c data model1(1)/4h /, model1(2)/4h /, model1(3)/4h /,
-c 1 model1(4)/4h /, model1(5)/4h g /, model1(6)/4h s /,
-c 2 model2(1)/4h g /, model2(2)/4h s /, model2(3)/4hg-s /,
-c 3 model2(4)/4hs-g /, model2(5)/4h-s-g/, model2(6)/4h-g-s/
-c/7
- data model1/' ',' ',' ',' ',' g ',' s '/,
- 1 model2/' g ',' s ','g-s ','s-g ','-s-g','-g-s'/
-c/
-c
-c------------------------------- body --------------------------------
-c
- pu = iv(prunit)
- if (pu .eq. 0) go to 999
- iv1 = iv(1)
- if (iv1 .gt. 62) iv1 = iv1 - 51
- ol = iv(outlev)
- alg = iv(algsav)
- if (iv1 .lt. 2 .or. iv1 .gt. 15) go to 370
- if (iv1 .ge. 12) go to 120
- if (iv1 .eq. 2 .and. iv(niter) .eq. 0) go to 390
- if (ol .eq. 0) go to 120
- if (iv1 .ge. 10 .and. iv(prntit) .eq. 0) go to 120
- if (iv1 .gt. 2) go to 10
- iv(prntit) = iv(prntit) + 1
- if (iv(prntit) .lt. iabs(ol)) go to 999
- 10 nf = iv(nfcall) - iabs(iv(nfcov))
- iv(prntit) = 0
- reldf = zero
- preldf = zero
- oldf = dmax1(dabs(v(f0)), dabs(v(f)))
- if (oldf .le. zero) go to 20
- reldf = v(fdif) / oldf
- preldf = v(preduc) / oldf
- 20 if (ol .gt. 0) go to 60
-c
-c *** print short summary line ***
-c
- if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,30)
- 30 format(/10h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx,
- 1 2x,13hmodel stppar)
- if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,40)
- 40 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx,
- 1 3x,6hstppar)
- iv(needhd) = 0
- if (alg .eq. 2) go to 50
- m = iv(sused)
- write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx),
- 1 model1(m), model2(m), v(stppar)
- go to 120
-c
- 50 write(pu,110) iv(niter), nf, v(f), reldf, preldf, v(reldx),
- 1 v(stppar)
- go to 120
-c
-c *** print long summary line ***
-c
- 60 if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,70)
- 70 format(/11h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx,
- 1 2x,13hmodel stppar,2x,6hd*step,2x,7hnpreldf)
- if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,80)
- 80 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx,
- 1 3x,6hstppar,3x,6hd*step,3x,7hnpreldf)
- iv(needhd) = 0
- nreldf = zero
- if (oldf .gt. zero) nreldf = v(nreduc) / oldf
- if (alg .eq. 2) go to 90
- m = iv(sused)
- write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx),
- 1 model1(m), model2(m), v(stppar), v(dstnrm), nreldf
- go to 120
-c
- 90 write(pu,110) iv(niter), nf, v(f), reldf, preldf,
- 1 v(reldx), v(stppar), v(dstnrm), nreldf
- 100 format(i6,i5,d10.3,2d9.2,d8.1,a3,a4,2d8.1,d9.2)
- 110 format(i6,i5,d11.3,2d10.2,3d9.1,d10.2)
-c
- 120 if (iv(statpr) .lt. 0) go to 430
- go to (999, 999, 130, 150, 170, 190, 210, 230, 250, 270, 290, 310,
- 1 330, 350, 520), iv1
-c
- 130 write(pu,140)
- 140 format(/26h ***** x-convergence *****)
- go to 430
-c
- 150 write(pu,160)
- 160 format(/42h ***** relative function convergence *****)
- go to 430
-c
- 170 write(pu,180)
- 180 format(/49h ***** x- and relative function convergence *****)
- go to 430
-c
- 190 write(pu,200)
- 200 format(/42h ***** absolute function convergence *****)
- go to 430
-c
- 210 write(pu,220)
- 220 format(/33h ***** singular convergence *****)
- go to 430
-c
- 230 write(pu,240)
- 240 format(/30h ***** false convergence *****)
- go to 430
-c
- 250 write(pu,260)
- 260 format(/38h ***** function evaluation limit *****)
- go to 430
-c
- 270 write(pu,280)
- 280 format(/28h ***** iteration limit *****)
- go to 430
-c
- 290 write(pu,300)
- 300 format(/18h ***** stopx *****)
- go to 430
-c
- 310 write(pu,320)
- 320 format(/44h ***** initial f(x) cannot be computed *****)
-c
- go to 390
-c
- 330 write(pu,340)
- 340 format(/37h ***** bad parameters to assess *****)
- go to 999
-c
- 350 write(pu,360)
- 360 format(/43h ***** gradient could not be computed *****)
- if (iv(niter) .gt. 0) go to 480
- go to 390
-c
- 370 write(pu,380) iv(1)
- 380 format(/14h ***** iv(1) =,i5,6h *****)
- go to 999
-c
-c *** initial call on itsum ***
-c
- 390 if (iv(x0prt) .ne. 0) write(pu,400) (i, x(i), d(i), i = 1, p)
- 400 format(/23h i initial x(i),8x,4hd(i)//(1x,i5,d17.6,d14.3))
-c *** the following are to avoid undefined variables when the
-c *** function evaluation limit is 1...
- v(dstnrm) = zero
- v(fdif) = zero
- v(nreduc) = zero
- v(preduc) = zero
- v(reldx) = zero
- if (iv1 .ge. 12) go to 999
- iv(needhd) = 0
- iv(prntit) = 0
- if (ol .eq. 0) go to 999
- if (ol .lt. 0 .and. alg .eq. 1) write(pu,30)
- if (ol .lt. 0 .and. alg .eq. 2) write(pu,40)
- if (ol .gt. 0 .and. alg .eq. 1) write(pu,70)
- if (ol .gt. 0 .and. alg .eq. 2) write(pu,80)
- if (alg .eq. 1) write(pu,410) v(f)
- if (alg .eq. 2) write(pu,420) v(f)
- 410 format(/11h 0 1,d10.3)
-c365 format(/11h 0 1,e11.3)
- 420 format(/11h 0 1,d11.3)
- go to 999
-c
-c *** print various information requested on solution ***
-c
- 430 iv(needhd) = 1
- if (iv(statpr) .eq. 0) go to 480
- oldf = dmax1(dabs(v(f0)), dabs(v(f)))
- preldf = zero
- nreldf = zero
- if (oldf .le. zero) go to 440
- preldf = v(preduc) / oldf
- nreldf = v(nreduc) / oldf
- 440 nf = iv(nfcall) - iv(nfcov)
- ng = iv(ngcall) - iv(ngcov)
- write(pu,450) v(f), v(reldx), nf, ng, preldf, nreldf
- 450 format(/9h function,d17.6,8h reldx,d17.3/12h func. evals,
- 1 i8,9x,11hgrad. evals,i8/7h preldf,d16.3,6x,7hnpreldf,d15.3)
-c
- if (iv(nfcov) .gt. 0) write(pu,460) iv(nfcov)
- 460 format(/1x,i4,50h extra func. evals for covariance and diagnost
- 1ics.)
- if (iv(ngcov) .gt. 0) write(pu,470) iv(ngcov)
- 470 format(1x,i4,50h extra grad. evals for covariance and diagnosti
- 1cs.)
-c
- 480 if (iv(solprt) .eq. 0) go to 999
- iv(needhd) = 1
- write(pu,490)
- 490 format(/22h i final x(i),8x,4hd(i),10x,4hg(i)/)
- do 500 i = 1, p
- write(pu,510) i, x(i), d(i), g(i)
- 500 continue
- 510 format(1x,i5,d16.6,2d14.3)
- go to 999
-c
- 520 write(pu,530)
- 530 format(/24h inconsistent dimensions)
- 999 return
-c *** last card of itsum follows ***
- end
- subroutine litvmu(n, x, l, y)
-c
-c *** solve (l**t)*x = y, where l is an n x n lower triangular
-c *** matrix stored compactly by rows. x and y may occupy the same
-c *** storage. ***
-c
- integer n
-cal double precision x(n), l(1), y(n)
- double precision x(n), l(n*(n+1)/2), y(n)
- integer i, ii, ij, im1, i0, j, np1
- double precision xi, zero
-c/6
-c data zero/0.d+0/
-c/7
- parameter (zero=0.d+0)
-c/
-c
- do 10 i = 1, n
- 10 x(i) = y(i)
- np1 = n + 1
- i0 = n*(n+1)/2
- do 30 ii = 1, n
- i = np1 - ii
- xi = x(i)/l(i0)
- x(i) = xi
- if (i .le. 1) go to 999
- i0 = i0 - i
- if (xi .eq. zero) go to 30
- im1 = i - 1
- do 20 j = 1, im1
- ij = i0 + j
- x(j) = x(j) - xi*l(ij)
- 20 continue
- 30 continue
- 999 return
-c *** last card of litvmu follows ***
- end
- subroutine livmul(n, x, l, y)
-c
-c *** solve l*x = y, where l is an n x n lower triangular
-c *** matrix stored compactly by rows. x and y may occupy the same
-c *** storage. ***
-c
- integer n
-cal double precision x(n), l(1), y(n)
- double precision x(n), l(n*(n+1)/2), y(n)
- external dotprd
- double precision dotprd
- integer i, j, k
- double precision t, zero
-c/6
-c data zero/0.d+0/
-c/7
- parameter (zero=0.d+0)
-c/
-c
- do 10 k = 1, n
- if (y(k) .ne. zero) go to 20
- x(k) = zero
- 10 continue
- go to 999
- 20 j = k*(k+1)/2
- x(k) = y(k) / l(j)
- if (k .ge. n) go to 999
- k = k + 1
- do 30 i = k, n
- t = dotprd(i-1, l(j+1), x)
- j = j + i
- x(i) = (y(i) - t)/l(j)
- 30 continue
- 999 return
-c *** last card of livmul follows ***
- end
- subroutine parck(alg, d, iv, liv, lv, n, v)
-c
-c *** check ***sol (version 2.3) parameters, print changed values ***
-c
-c *** alg = 1 for regression, alg = 2 for general unconstrained opt.
-c
- integer alg, liv, lv, n
- integer iv(liv)
- double precision d(n), v(lv)
-c
- external rmdcon, vcopy, vdflt
- double precision rmdcon
-c rmdcon -- returns machine-dependent constants.
-c vcopy -- copies one vector to another.
-c vdflt -- supplies default parameter values to v alone.
-c/+
- integer max0
-c/
-c
-c *** local variables ***
-c
- integer i, ii, iv1, j, k, l, m, miv1, miv2, ndfalt, parsv1, pu
- integer ijmp, jlim(2), miniv(2), ndflt(2)
-c/6
-c integer varnm(2), sh(2)
-c real cngd(3), dflt(3), vn(2,34), which(3)
-c/7
- character*1 varnm(2), sh(2)
- character*4 cngd(3), dflt(3), vn(2,34), which(3)
-c/
- double precision big, machep, tiny, vk, vm(34), vx(34), zero
-c
-c *** iv and v subscripts ***
-c
- integer algsav, dinit, dtype, dtype0, epslon, inits, ivneed,
- 1 lastiv, lastv, lmat, nextiv, nextv, nvdflt, oldn,
- 2 parprt, parsav, perm, prunit, vneed
-c
-c
-c/6
-c data algsav/51/, dinit/38/, dtype/16/, dtype0/54/, epslon/19/,
-c 1 inits/25/, ivneed/3/, lastiv/44/, lastv/45/, lmat/42/,
-c 2 nextiv/46/, nextv/47/, nvdflt/50/, oldn/38/, parprt/20/,
-c 3 parsav/49/, perm/58/, prunit/21/, vneed/4/
-c/7
- parameter (algsav=51, dinit=38, dtype=16, dtype0=54, epslon=19,
- 1 inits=25, ivneed=3, lastiv=44, lastv=45, lmat=42,
- 2 nextiv=46, nextv=47, nvdflt=50, oldn=38, parprt=20,
- 3 parsav=49, perm=58, prunit=21, vneed=4)
- save big, machep, tiny
-c/
-c
- data big/0.d+0/, machep/-1.d+0/, tiny/1.d+0/, zero/0.d+0/
-c/6
-c data vn(1,1),vn(2,1)/4hepsl,4hon../
-c data vn(1,2),vn(2,2)/4hphmn,4hfc../
-c data vn(1,3),vn(2,3)/4hphmx,4hfc../
-c data vn(1,4),vn(2,4)/4hdecf,4hac../
-c data vn(1,5),vn(2,5)/4hincf,4hac../
-c data vn(1,6),vn(2,6)/4hrdfc,4hmn../
-c data vn(1,7),vn(2,7)/4hrdfc,4hmx../
-c data vn(1,8),vn(2,8)/4htune,4hr1../
-c data vn(1,9),vn(2,9)/4htune,4hr2../
-c data vn(1,10),vn(2,10)/4htune,4hr3../
-c data vn(1,11),vn(2,11)/4htune,4hr4../
-c data vn(1,12),vn(2,12)/4htune,4hr5../
-c data vn(1,13),vn(2,13)/4hafct,4hol../
-c data vn(1,14),vn(2,14)/4hrfct,4hol../
-c data vn(1,15),vn(2,15)/4hxcto,4hl.../
-c data vn(1,16),vn(2,16)/4hxfto,4hl.../
-c data vn(1,17),vn(2,17)/4hlmax,4h0.../
-c data vn(1,18),vn(2,18)/4hlmax,4hs.../
-c data vn(1,19),vn(2,19)/4hscto,4hl.../
-c data vn(1,20),vn(2,20)/4hdini,4ht.../
-c data vn(1,21),vn(2,21)/4hdtin,4hit../
-c data vn(1,22),vn(2,22)/4hd0in,4hit../
-c data vn(1,23),vn(2,23)/4hdfac,4h..../
-c data vn(1,24),vn(2,24)/4hdltf,4hdc../
-c data vn(1,25),vn(2,25)/4hdltf,4hdj../
-c data vn(1,26),vn(2,26)/4hdelt,4ha0../
-c data vn(1,27),vn(2,27)/4hfuzz,4h..../
-c data vn(1,28),vn(2,28)/4hrlim,4hit../
-c data vn(1,29),vn(2,29)/4hcosm,4hin../
-c data vn(1,30),vn(2,30)/4hhube,4hrc../
-c data vn(1,31),vn(2,31)/4hrspt,4hol../
-c data vn(1,32),vn(2,32)/4hsigm,4hin../
-c data vn(1,33),vn(2,33)/4heta0,4h..../
-c data vn(1,34),vn(2,34)/4hbias,4h..../
-c/7
- data vn(1,1),vn(2,1)/'epsl','on..'/
- data vn(1,2),vn(2,2)/'phmn','fc..'/
- data vn(1,3),vn(2,3)/'phmx','fc..'/
- data vn(1,4),vn(2,4)/'decf','ac..'/
- data vn(1,5),vn(2,5)/'incf','ac..'/
- data vn(1,6),vn(2,6)/'rdfc','mn..'/
- data vn(1,7),vn(2,7)/'rdfc','mx..'/
- data vn(1,8),vn(2,8)/'tune','r1..'/
- data vn(1,9),vn(2,9)/'tune','r2..'/
- data vn(1,10),vn(2,10)/'tune','r3..'/
- data vn(1,11),vn(2,11)/'tune','r4..'/
- data vn(1,12),vn(2,12)/'tune','r5..'/
- data vn(1,13),vn(2,13)/'afct','ol..'/
- data vn(1,14),vn(2,14)/'rfct','ol..'/
- data vn(1,15),vn(2,15)/'xcto','l...'/
- data vn(1,16),vn(2,16)/'xfto','l...'/
- data vn(1,17),vn(2,17)/'lmax','0...'/
- data vn(1,18),vn(2,18)/'lmax','s...'/
- data vn(1,19),vn(2,19)/'scto','l...'/
- data vn(1,20),vn(2,20)/'dini','t...'/
- data vn(1,21),vn(2,21)/'dtin','it..'/
- data vn(1,22),vn(2,22)/'d0in','it..'/
- data vn(1,23),vn(2,23)/'dfac','....'/
- data vn(1,24),vn(2,24)/'dltf','dc..'/
- data vn(1,25),vn(2,25)/'dltf','dj..'/
- data vn(1,26),vn(2,26)/'delt','a0..'/
- data vn(1,27),vn(2,27)/'fuzz','....'/
- data vn(1,28),vn(2,28)/'rlim','it..'/
- data vn(1,29),vn(2,29)/'cosm','in..'/
- data vn(1,30),vn(2,30)/'hube','rc..'/
- data vn(1,31),vn(2,31)/'rspt','ol..'/
- data vn(1,32),vn(2,32)/'sigm','in..'/
- data vn(1,33),vn(2,33)/'eta0','....'/
- data vn(1,34),vn(2,34)/'bias','....'/
-c/
-c
- data vm(1)/1.0d-3/, vm(2)/-0.99d+0/, vm(3)/1.0d-3/, vm(4)/1.0d-2/,
- 1 vm(5)/1.2d+0/, vm(6)/1.d-2/, vm(7)/1.2d+0/, vm(8)/0.d+0/,
- 2 vm(9)/0.d+0/, vm(10)/1.d-3/, vm(11)/-1.d+0/, vm(13)/0.d+0/,
- 3 vm(15)/0.d+0/, vm(16)/0.d+0/, vm(19)/0.d+0/, vm(20)/-10.d+0/,
- 4 vm(21)/0.d+0/, vm(22)/0.d+0/, vm(23)/0.d+0/, vm(27)/1.01d+0/,
- 5 vm(28)/1.d+10/, vm(30)/0.d+0/, vm(31)/0.d+0/, vm(32)/0.d+0/,
- 6 vm(34)/0.d+0/
- data vx(1)/0.9d+0/, vx(2)/-1.d-3/, vx(3)/1.d+1/, vx(4)/0.8d+0/,
- 1 vx(5)/1.d+2/, vx(6)/0.8d+0/, vx(7)/1.d+2/, vx(8)/0.5d+0/,
- 2 vx(9)/0.5d+0/, vx(10)/1.d+0/, vx(11)/1.d+0/, vx(14)/0.1d+0/,
- 3 vx(15)/1.d+0/, vx(16)/1.d+0/, vx(19)/1.d+0/, vx(23)/1.d+0/,
- 4 vx(24)/1.d+0/, vx(25)/1.d+0/, vx(26)/1.d+0/, vx(27)/1.d+10/,
- 5 vx(29)/1.d+0/, vx(31)/1.d+0/, vx(32)/1.d+0/, vx(33)/1.d+0/,
- 6 vx(34)/1.d+0/
-c
-c/6
-c data varnm(1)/1hp/, varnm(2)/1hn/, sh(1)/1hs/, sh(2)/1hh/
-c data cngd(1),cngd(2),cngd(3)/4h---c,4hhang,4hed v/,
-c 1 dflt(1),dflt(2),dflt(3)/4hnond,4hefau,4hlt v/
-c/7
- data varnm(1)/'p'/, varnm(2)/'n'/, sh(1)/'s'/, sh(2)/'h'/
- data cngd(1),cngd(2),cngd(3)/'---c','hang','ed v'/,
- 1 dflt(1),dflt(2),dflt(3)/'nond','efau','lt v'/
-c/
- data ijmp/33/, jlim(1)/0/, jlim(2)/24/, ndflt(1)/32/, ndflt(2)/25/
- data miniv(1)/80/, miniv(2)/59/
-c
-c............................... body ................................
-c
- pu = 0
- if (prunit .le. liv) pu = iv(prunit)
- if (alg .lt. 1 .or. alg .gt. 2) go to 340
- if (iv(1) .eq. 0) call deflt(alg, iv, liv, lv, v)
- iv1 = iv(1)
- if (iv1 .ne. 13 .and. iv1 .ne. 12) go to 10
- miv1 = miniv(alg)
- if (perm .le. liv) miv1 = max0(miv1, iv(perm) - 1)
- if (ivneed .le. liv) miv2 = miv1 + max0(iv(ivneed), 0)
- if (lastiv .le. liv) iv(lastiv) = miv2
- if (liv .lt. miv1) go to 300
- iv(ivneed) = 0
- iv(lastv) = max0(iv(vneed), 0) + iv(lmat) - 1
- iv(vneed) = 0
- if (liv .lt. miv2) go to 300
- if (lv .lt. iv(lastv)) go to 320
- 10 if (alg .eq. iv(algsav)) go to 30
- if (pu .ne. 0) write(pu,20) alg, iv(algsav)
- 20 format(/39h the first parameter to deflt should be,i3,
- 1 12h rather than,i3)
- iv(1) = 82
- go to 999
- 30 if (iv1 .lt. 12 .or. iv1 .gt. 14) go to 60
- if (n .ge. 1) go to 50
- iv(1) = 81
- if (pu .eq. 0) go to 999
- write(pu,40) varnm(alg), n
- 40 format(/8h /// bad,a1,2h =,i5)
- go to 999
- 50 if (iv1 .ne. 14) iv(nextiv) = iv(perm)
- if (iv1 .ne. 14) iv(nextv) = iv(lmat)
- if (iv1 .eq. 13) go to 999
- k = iv(parsav) - epslon
- call vdflt(alg, lv-k, v(k+1))
- iv(dtype0) = 2 - alg
- iv(oldn) = n
- which(1) = dflt(1)
- which(2) = dflt(2)
- which(3) = dflt(3)
- go to 110
- 60 if (n .eq. iv(oldn)) go to 80
- iv(1) = 17
- if (pu .eq. 0) go to 999
- write(pu,70) varnm(alg), iv(oldn), n
- 70 format(/5h /// ,1a1,14h changed from ,i5,4h to ,i5)
- go to 999
-c
- 80 if (iv1 .le. 11 .and. iv1 .ge. 1) go to 100
- iv(1) = 80
- if (pu .ne. 0) write(pu,90) iv1
- 90 format(/13h /// iv(1) =,i5,28h should be between 0 and 14.)
- go to 999
-c
- 100 which(1) = cngd(1)
- which(2) = cngd(2)
- which(3) = cngd(3)
-c
- 110 if (iv1 .eq. 14) iv1 = 12
- if (big .gt. tiny) go to 120
- tiny = rmdcon(1)
- machep = rmdcon(3)
- big = rmdcon(6)
- vm(12) = machep
- vx(12) = big
- vx(13) = big
- vm(14) = machep
- vm(17) = tiny
- vx(17) = big
- vm(18) = tiny
- vx(18) = big
- vx(20) = big
- vx(21) = big
- vx(22) = big
- vm(24) = machep
- vm(25) = machep
- vm(26) = machep
- vx(28) = rmdcon(5)
- vm(29) = machep
- vx(30) = big
- vm(33) = machep
- 120 m = 0
- i = 1
- j = jlim(alg)
- k = epslon
- ndfalt = ndflt(alg)
- do 150 l = 1, ndfalt
- vk = v(k)
- if (vk .ge. vm(i) .and. vk .le. vx(i)) go to 140
- m = k
- if (pu .ne. 0) write(pu,130) vn(1,i), vn(2,i), k, vk,
- 1 vm(i), vx(i)
- 130 format(/6h /// ,2a4,5h.. v(,i2,3h) =,d11.3,7h should,
- 1 11h be between,d11.3,4h and,d11.3)
- 140 k = k + 1
- i = i + 1
- if (i .eq. j) i = ijmp
- 150 continue
-c
- if (iv(nvdflt) .eq. ndfalt) go to 170
- iv(1) = 51
- if (pu .eq. 0) go to 999
- write(pu,160) iv(nvdflt), ndfalt
- 160 format(/13h iv(nvdflt) =,i5,13h rather than ,i5)
- go to 999
- 170 if ((iv(dtype) .gt. 0 .or. v(dinit) .gt. zero) .and. iv1 .eq. 12)
- 1 go to 200
- do 190 i = 1, n
- if (d(i) .gt. zero) go to 190
- m = 18
- if (pu .ne. 0) write(pu,180) i, d(i)
- 180 format(/8h /// d(,i3,3h) =,d11.3,19h should be positive)
- 190 continue
- 200 if (m .eq. 0) go to 210
- iv(1) = m
- go to 999
-c
- 210 if (pu .eq. 0 .or. iv(parprt) .eq. 0) go to 999
- if (iv1 .ne. 12 .or. iv(inits) .eq. alg-1) go to 230
- m = 1
- write(pu,220) sh(alg), iv(inits)
- 220 format(/22h nondefault values..../5h init,a1,14h..... iv(25) =,
- 1 i3)
- 230 if (iv(dtype) .eq. iv(dtype0)) go to 250
- if (m .eq. 0) write(pu,260) which
- m = 1
- write(pu,240) iv(dtype)
- 240 format(20h dtype..... iv(16) =,i3)
- 250 i = 1
- j = jlim(alg)
- k = epslon
- l = iv(parsav)
- ndfalt = ndflt(alg)
- do 290 ii = 1, ndfalt
- if (v(k) .eq. v(l)) go to 280
- if (m .eq. 0) write(pu,260) which
- 260 format(/1h ,3a4,9halues..../)
- m = 1
- write(pu,270) vn(1,i), vn(2,i), k, v(k)
- 270 format(1x,2a4,5h.. v(,i2,3h) =,d15.7)
- 280 k = k + 1
- l = l + 1
- i = i + 1
- if (i .eq. j) i = ijmp
- 290 continue
-c
- iv(dtype0) = iv(dtype)
- parsv1 = iv(parsav)
- call vcopy(iv(nvdflt), v(parsv1), v(epslon))
- go to 999
-c
- 300 iv(1) = 15
- if (pu .eq. 0) go to 999
- write(pu,310) liv, miv2
- 310 format(/10h /// liv =,i5,17h must be at least,i5)
- if (liv .lt. miv1) go to 999
- if (lv .lt. iv(lastv)) go to 320
- go to 999
-c
- 320 iv(1) = 16
- if (pu .eq. 0) go to 999
- write(pu,330) lv, iv(lastv)
- 330 format(/9h /// lv =,i5,17h must be at least,i5)
- go to 999
-c
- 340 iv(1) = 67
- if (pu .eq. 0) go to 999
- write(pu,350) alg
- 350 format(/10h /// alg =,i5,15h must be 1 or 2)
-c
- 999 return
-c *** last card of parck follows ***
- end
- double precision function reldst(p, d, x, x0)
-c
-c *** compute and return relative difference between x and x0 ***
-c *** nl2sol version 2.2 ***
-c
- integer p
- double precision d(p), x(p), x0(p)
-c/+
- double precision dabs
-c/
- integer i
- double precision emax, t, xmax, zero
-c/6
-c data zero/0.d+0/
-c/7
- parameter (zero=0.d+0)
-c/
-c
- emax = zero
- xmax = zero
- do 10 i = 1, p
- t = dabs(d(i) * (x(i) - x0(i)))
- if (emax .lt. t) emax = t
- t = d(i) * (dabs(x(i)) + dabs(x0(i)))
- if (xmax .lt. t) xmax = t
- 10 continue
- reldst = zero
- if (xmax .gt. zero) reldst = emax / xmax
- 999 return
-c *** last card of reldst follows ***
- end
-c logical function stopx(idummy)
-c *****parameters...
-c integer idummy
-c
-c ..................................................................
-c
-c *****purpose...
-c this function may serve as the stopx (asynchronous interruption)
-c function for the nl2sol (nonlinear least-squares) package at
-c those installations which do not wish to implement a
-c dynamic stopx.
-c
-c *****algorithm notes...
-c at installations where the nl2sol system is used
-c interactively, this dummy stopx should be replaced by a
-c function that returns .true. if and only if the interrupt
-c (break) key has been pressed since the last call on stopx.
-c
-c ..................................................................
-c
-c stopx = .false.
-c return
-c end
- subroutine vaxpy(p, w, a, x, y)
-c
-c *** set w = a*x + y -- w, x, y = p-vectors, a = scalar ***
-c
- integer p
- double precision a, w(p), x(p), y(p)
-c
- integer i
-c
- do 10 i = 1, p
- 10 w(i) = a*x(i) + y(i)
- return
- end
- subroutine vcopy(p, y, x)
-c
-c *** set y = x, where x and y are p-vectors ***
-c
- integer p
- double precision x(p), y(p)
-c
- integer i
-c
- do 10 i = 1, p
- 10 y(i) = x(i)
- return
- end
- subroutine vdflt(alg, lv, v)
-c
-c *** supply ***sol (version 2.3) default values to v ***
-c
-c *** alg = 1 means regression constants.
-c *** alg = 2 means general unconstrained optimization constants.
-c
- integer alg, l
- double precision v(lv)
-c/+
- double precision dmax1
-c/
- external rmdcon
- double precision rmdcon
-c rmdcon... returns machine-dependent constants
-c
- double precision machep, mepcrt, one, sqteps, three
-c
-c *** subscripts for v ***
-c
- integer afctol, bias, cosmin, decfac, delta0, dfac, dinit, dltfdc,
- 1 dltfdj, dtinit, d0init, epslon, eta0, fuzz, huberc,
- 2 incfac, lmax0, lmaxs, phmnfc, phmxfc, rdfcmn, rdfcmx,
- 3 rfctol, rlimit, rsptol, sctol, sigmin, tuner1, tuner2,
- 4 tuner3, tuner4, tuner5, xctol, xftol
-c
-c/6
-c data one/1.d+0/, three/3.d+0/
-c/7
- parameter (one=1.d+0, three=3.d+0)
-c/
-c
-c *** v subscript values ***
-c
-c/6
-c data afctol/31/, bias/43/, cosmin/47/, decfac/22/, delta0/44/,
-c 1 dfac/41/, dinit/38/, dltfdc/42/, dltfdj/43/, dtinit/39/,
-c 2 d0init/40/, epslon/19/, eta0/42/, fuzz/45/, huberc/48/,
-c 3 incfac/23/, lmax0/35/, lmaxs/36/, phmnfc/20/, phmxfc/21/,
-c 4 rdfcmn/24/, rdfcmx/25/, rfctol/32/, rlimit/46/, rsptol/49/,
-c 5 sctol/37/, sigmin/50/, tuner1/26/, tuner2/27/, tuner3/28/,
-c 6 tuner4/29/, tuner5/30/, xctol/33/, xftol/34/
-c/7
- parameter (afctol=31, bias=43, cosmin=47, decfac=22, delta0=44,
- 1 dfac=41, dinit=38, dltfdc=42, dltfdj=43, dtinit=39,
- 2 d0init=40, epslon=19, eta0=42, fuzz=45, huberc=48,
- 3 incfac=23, lmax0=35, lmaxs=36, phmnfc=20, phmxfc=21,
- 4 rdfcmn=24, rdfcmx=25, rfctol=32, rlimit=46, rsptol=49,
- 5 sctol=37, sigmin=50, tuner1=26, tuner2=27, tuner3=28,
- 6 tuner4=29, tuner5=30, xctol=33, xftol=34)
-c/
-c
-c------------------------------- body --------------------------------
-c
- machep = rmdcon(3)
- v(afctol) = 1.d-20
- if (machep .gt. 1.d-10) v(afctol) = machep**2
- v(decfac) = 0.5d+0
- sqteps = rmdcon(4)
- v(dfac) = 0.6d+0
- v(delta0) = sqteps
- v(dtinit) = 1.d-6
- mepcrt = machep ** (one/three)
- v(d0init) = 1.d+0
- v(epslon) = 0.1d+0
- v(incfac) = 2.d+0
- v(lmax0) = 1.d+0
- v(lmaxs) = 1.d+0
- v(phmnfc) = -0.1d+0
- v(phmxfc) = 0.1d+0
- v(rdfcmn) = 0.1d+0
- v(rdfcmx) = 4.d+0
- v(rfctol) = dmax1(1.d-10, mepcrt**2)
- v(sctol) = v(rfctol)
- v(tuner1) = 0.1d+0
- v(tuner2) = 1.d-4
- v(tuner3) = 0.75d+0
- v(tuner4) = 0.5d+0
- v(tuner5) = 0.75d+0
- v(xctol) = sqteps
- v(xftol) = 1.d+2 * machep
-c
- if (alg .ge. 2) go to 10
-c
-c *** regression values
-c
- v(cosmin) = dmax1(1.d-6, 1.d+2 * machep)
- v(dinit) = 0.d+0
- v(dltfdc) = mepcrt
- v(dltfdj) = sqteps
- v(fuzz) = 1.5d+0
- v(huberc) = 0.7d+0
- v(rlimit) = rmdcon(5)
- v(rsptol) = 1.d-3
- v(sigmin) = 1.d-4
- go to 999
-c
-c *** general optimization values
-c
- 10 v(bias) = 0.8d+0
- v(dinit) = -1.0d+0
- v(eta0) = 1.0d+3 * machep
-c
- 999 return
-c *** last card of vdflt follows ***
- end
- subroutine vscopy(p, y, s)
-c
-c *** set p-vector y to scalar s ***
-c
- integer p
- double precision s, y(p)
-c
- integer i
-c
- do 10 i = 1, p
- 10 y(i) = s
- return
- end
- double precision function v2norm(p, x)
-c
-c *** return the 2-norm of the p-vector x, taking ***
-c *** care to avoid the most likely underflows. ***
-c
- integer p
- double precision x(p)
-c
- integer i, j
- double precision one, r, scale, sqteta, t, xi, zero
-c/+
- double precision dabs, dsqrt
-c/
- external rmdcon
- double precision rmdcon
-c
-c/6
-c data one/1.d+0/, zero/0.d+0/
-c/7
- parameter (one=1.d+0, zero=0.d+0)
- save sqteta
-c/
- data sqteta/0.d+0/
-c
- if (p .gt. 0) go to 10
- v2norm = zero
- go to 999
- 10 do 20 i = 1, p
- if (x(i) .ne. zero) go to 30
- 20 continue
- v2norm = zero
- go to 999
-c
- 30 scale = dabs(x(i))
- if (i .lt. p) go to 40
- v2norm = scale
- go to 999
- 40 t = one
- if (sqteta .eq. zero) sqteta = rmdcon(2)
-c
-c *** sqteta is (slightly larger than) the square root of the
-c *** smallest positive floating point number on the machine.
-c *** the tests involving sqteta are done to prevent underflows.
-c
- j = i + 1
- do 60 i = j, p
- xi = dabs(x(i))
- if (xi .gt. scale) go to 50
- r = xi / scale
- if (r .gt. sqteta) t = t + r*r
- go to 60
- 50 r = scale / xi
- if (r .le. sqteta) r = zero
- t = one + t * r*r
- scale = xi
- 60 continue
-c
- v2norm = scale * dsqrt(t)
- 999 return
-c *** last card of v2norm follows ***
- end
- subroutine humsl(n, d, x, calcf, calcgh, iv, liv, lv, v,
- 1 uiparm, urparm, ufparm)
-c
-c *** minimize general unconstrained objective function using ***
-c *** (analytic) gradient and hessian provided by the caller. ***
-c
- integer liv, lv, n
- integer iv(liv), uiparm(1)
- double precision d(n), x(n), v(lv), urparm(1)
-c dimension v(78 + n*(n+12)), uiparm(*), urparm(*)
- external calcf, calcgh, ufparm
-c
-c------------------------------ discussion ---------------------------
-c
-c this routine is like sumsl, except that the subroutine para-
-c meter calcg of sumsl (which computes the gradient of the objec-
-c tive function) is replaced by the subroutine parameter calcgh,
-c which computes both the gradient and (lower triangle of the)
-c hessian of the objective function. the calling sequence is...
-c call calcgh(n, x, nf, g, h, uiparm, urparm, ufparm)
-c parameters n, x, nf, g, uiparm, urparm, and ufparm are the same
-c as for sumsl, while h is an array of length n*(n+1)/2 in which
-c calcgh must store the lower triangle of the hessian at x. start-
-c ing at h(1), calcgh must store the hessian entries in the order
-c (1,1), (2,1), (2,2), (3,1), (3,2), (3,3), ...
-c the value printed (by itsum) in the column labelled stppar
-c is the levenberg-marquardt used in computing the current step.
-c zero means a full newton step. if the special case described in
-c ref. 1 is detected, then stppar is negated. the value printed
-c in the column labelled npreldf is zero if the current hessian
-c is not positive definite.
-c it sometimes proves worthwhile to let d be determined from the
-c diagonal of the hessian matrix by setting iv(dtype) = 1 and
-c v(dinit) = 0. the following iv and v components are relevant...
-c
-c iv(dtol)..... iv(59) gives the starting subscript in v of the dtol
-c array used when d is updated. (iv(dtol) can be
-c initialized by calling humsl with iv(1) = 13.)
-c iv(dtype).... iv(16) tells how the scale vector d should be chosen.
-c iv(dtype) .le. 0 means that d should not be updated, and
-c iv(dtype) .ge. 1 means that d should be updated as
-c described below with v(dfac). default = 0.
-c v(dfac)..... v(41) and the dtol and d0 arrays (see v(dtinit) and
-c v(d0init)) are used in updating the scale vector d when
-c iv(dtype) .gt. 0. (d is initialized according to
-c v(dinit), described in sumsl.) let
-c d1(i) = max(sqrt(abs(h(i,i))), v(dfac)*d(i)),
-c where h(i,i) is the i-th diagonal element of the current
-c hessian. if iv(dtype) = 1, then d(i) is set to d1(i)
-c unless d1(i) .lt. dtol(i), in which case d(i) is set to
-c max(d0(i), dtol(i)).
-c if iv(dtype) .ge. 2, then d is updated during the first
-c iteration as for iv(dtype) = 1 (after any initialization
-c due to v(dinit)) and is left unchanged thereafter.
-c default = 0.6.
-c v(dtinit)... v(39), if positive, is the value to which all components
-c of the dtol array (see v(dfac)) are initialized. if
-c v(dtinit) = 0, then it is assumed that the caller has
-c stored dtol in v starting at v(iv(dtol)).
-c default = 10**-6.
-c v(d0init)... v(40), if positive, is the value to which all components
-c of the d0 vector (see v(dfac)) are initialized. if
-c v(dfac) = 0, then it is assumed that the caller has
-c stored d0 in v starting at v(iv(dtol)+n). default = 1.0.
-c
-c *** reference ***
-c
-c 1. gay, d.m. (1981), computing optimal locally constrained steps,
-c siam j. sci. statist. comput. 2, pp. 186-197.
-c.
-c *** general ***
-c
-c coded by david m. gay (winter 1980). revised sept. 1982.
-c this subroutine was written in connection with research supported
-c in part by the national science foundation under grants
-c mcs-7600324 and mcs-7906671.
-c
-c---------------------------- declarations ---------------------------
-c
- external deflt, humit
-c
-c deflt... provides default input values for iv and v.
-c humit... reverse-communication routine that does humsl algorithm.
-c
- integer g1, h1, iv1, lh, nf
- double precision f
-c
-c *** subscripts for iv ***
-c
- integer g, h, nextv, nfcall, nfgcal, toobig, vneed
-c
-c/6
-c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, h/56/, toobig/2/,
-c 1 vneed/4/
-c/7
- parameter (nextv=47, nfcall=6, nfgcal=7, g=28, h=56, toobig=2,
- 1 vneed=4)
-c/
-c
-c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++
-c
- lh = n * (n + 1) / 2
- if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v)
- if (iv(1) .eq. 12 .or. iv(1) .eq. 13)
- 1 iv(vneed) = iv(vneed) + n*(n+3)/2
- iv1 = iv(1)
- if (iv1 .eq. 14) go to 10
- if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10
- g1 = 1
- h1 = 1
- if (iv1 .eq. 12) iv(1) = 13
- go to 20
-c
- 10 g1 = iv(g)
- h1 = iv(h)
-c
- 20 call humit(d, f, v(g1), v(h1), iv, lh, liv, lv, n, v, x)
- if (iv(1) - 2) 30, 40, 50
-c
- 30 nf = iv(nfcall)
- call calcf(n, x, nf, f, uiparm, urparm, ufparm)
- if (nf .le. 0) iv(toobig) = 1
- go to 20
-c
- 40 call calcgh(n, x, iv(nfgcal), v(g1), v(h1), uiparm, urparm,
- 1 ufparm)
- go to 20
-c
- 50 if (iv(1) .ne. 14) go to 999
-c
-c *** storage allocation
-c
- iv(g) = iv(nextv)
- iv(h) = iv(g) + n
- iv(nextv) = iv(h) + n*(n+1)/2
- if (iv1 .ne. 13) go to 10
-c
- 999 return
-c *** last card of humsl follows ***
- end
- subroutine humit(d, fx, g, h, iv, lh, liv, lv, n, v, x)
-c
-c *** carry out humsl (unconstrained minimization) iterations, using
-c *** hessian matrix provided by the caller.
-c
-c *** parameter declarations ***
-c
- integer lh, liv, lv, n
- integer iv(liv)
- double precision d(n), fx, g(n), h(lh), v(lv), x(n)
-c
-c-------------------------- parameter usage --------------------------
-c
-c d.... scale vector.
-c fx... function value.
-c g.... gradient vector.
-c h.... lower triangle of the hessian, stored rowwise.
-c iv... integer value array.
-c lh... length of h = p*(p+1)/2.
-c liv.. length of iv (at least 60).
-c lv... length of v (at least 78 + n*(n+21)/2).
-c n.... number of variables (components in x and g).
-c v.... floating-point value array.
-c x.... parameter vector.
-c
-c *** discussion ***
-c
-c parameters iv, n, v, and x are the same as the corresponding
-c ones to humsl (which see), except that v can be shorter (since
-c the part of v that humsl uses for storing g and h is not needed).
-c moreover, compared with humsl, iv(1) may have the two additional
-c output values 1 and 2, which are explained below, as is the use
-c of iv(toobig) and iv(nfgcal). the value iv(g), which is an
-c output value from humsl, is not referenced by humit or the
-c subroutines it calls.
-c
-c iv(1) = 1 means the caller should set fx to f(x), the function value
-c at x, and call humit again, having changed none of the
-c other parameters. an exception occurs if f(x) cannot be
-c computed (e.g. if overflow would occur), which may happen
-c because of an oversized step. in this case the caller
-c should set iv(toobig) = iv(2) to 1, which will cause
-c humit to ignore fx and try a smaller step. the para-
-c meter nf that humsl passes to calcf (for possible use by
-c calcgh) is a copy of iv(nfcall) = iv(6).
-c iv(1) = 2 means the caller should set g to g(x), the gradient of f at
-c x, and h to the lower triangle of h(x), the hessian of f
-c at x, and call humit again, having changed none of the
-c other parameters except perhaps the scale vector d.
-c the parameter nf that humsl passes to calcg is
-c iv(nfgcal) = iv(7). if g(x) and h(x) cannot be evaluated,
-c then the caller may set iv(nfgcal) to 0, in which case
-c humit will return with iv(1) = 65.
-c note -- humit overwrites h with the lower triangle
-c of diag(d)**-1 * h(x) * diag(d)**-1.
-c.
-c *** general ***
-c
-c coded by david m. gay (winter 1980). revised sept. 1982.
-c this subroutine was written in connection with research supported
-c in part by the national science foundation under grants
-c mcs-7600324 and mcs-7906671.
-c
-c (see sumsl and humsl for references.)
-c
-c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++
-c
-c *** local variables ***
-c
- integer dg1, dummy, i, j, k, l, lstgst, nn1o2, step1,
- 1 temp1, w1, x01
- double precision t
-c
-c *** constants ***
-c
- double precision one, onep2, zero
-c
-c *** no intrinsic functions ***
-c
-c *** external functions and subroutines ***
-c
- external assst, deflt, dotprd, dupdu, gqtst, itsum, parck,
- 1 reldst, slvmul, stopx, vaxpy, vcopy, vscopy, v2norm
- logical stopx
- double precision dotprd, reldst, v2norm
-c
-c assst.... assesses candidate step.
-c deflt.... provides default iv and v input values.
-c dotprd... returns inner product of two vectors.
-c dupdu.... updates scale vector d.
-c gqtst.... computes optimally locally constrained step.
-c itsum.... prints iteration summary and info on initial and final x.
-c parck.... checks validity of input iv and v values.
-c reldst... computes v(reldx) = relative step size.
-c slvmul... multiplies symmetric matrix times vector, given the lower
-c triangle of the matrix.
-c stopx.... returns .true. if the break key has been pressed.
-c vaxpy.... computes scalar times one vector plus another.
-c vcopy.... copies one vector to another.
-c vscopy... sets all elements of a vector to a scalar.
-c v2norm... returns the 2-norm of a vector.
-c
-c *** subscripts for iv and v ***
-c
- integer cnvcod, dg, dgnorm, dinit, dstnrm, dtinit, dtol,
- 1 dtype, d0init, f, f0, fdif, gtstep, incfac, irc, kagqt,
- 2 lmat, lmax0, lmaxs, mode, model, mxfcal, mxiter, nextv,
- 3 nfcall, nfgcal, ngcall, niter, preduc, radfac, radinc,
- 4 radius, rad0, reldx, restor, step, stglim, stlstg, stppar,
- 5 toobig, tuner4, tuner5, vneed, w, xirc, x0
-c
-c *** iv subscript values ***
-c
-c/6
-c data cnvcod/55/, dg/37/, dtol/59/, dtype/16/, irc/29/, kagqt/33/,
-c 1 lmat/42/, mode/35/, model/5/, mxfcal/17/, mxiter/18/,
-c 2 nextv/47/, nfcall/6/, nfgcal/7/, ngcall/30/, niter/31/,
-c 3 radinc/8/, restor/9/, step/40/, stglim/11/, stlstg/41/,
-c 4 toobig/2/, vneed/4/, w/34/, xirc/13/, x0/43/
-c/7
- parameter (cnvcod=55, dg=37, dtol=59, dtype=16, irc=29, kagqt=33,
- 1 lmat=42, mode=35, model=5, mxfcal=17, mxiter=18,
- 2 nextv=47, nfcall=6, nfgcal=7, ngcall=30, niter=31,
- 3 radinc=8, restor=9, step=40, stglim=11, stlstg=41,
- 4 toobig=2, vneed=4, w=34, xirc=13, x0=43)
-c/
-c
-c *** v subscript values ***
-c
-c/6
-c data dgnorm/1/, dinit/38/, dstnrm/2/, dtinit/39/, d0init/40/,
-c 1 f/10/, f0/13/, fdif/11/, gtstep/4/, incfac/23/, lmax0/35/,
-c 2 lmaxs/36/, preduc/7/, radfac/16/, radius/8/, rad0/9/,
-c 3 reldx/17/, stppar/5/, tuner4/29/, tuner5/30/
-c/7
- parameter (dgnorm=1, dinit=38, dstnrm=2, dtinit=39, d0init=40,
- 1 f=10, f0=13, fdif=11, gtstep=4, incfac=23, lmax0=35,
- 2 lmaxs=36, preduc=7, radfac=16, radius=8, rad0=9,
- 3 reldx=17, stppar=5, tuner4=29, tuner5=30)
-c/
-c
-c/6
-c data one/1.d+0/, onep2/1.2d+0/, zero/0.d+0/
-c/7
- parameter (one=1.d+0, onep2=1.2d+0, zero=0.d+0)
-c/
-c
-c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++
-c
- i = iv(1)
- if (i .eq. 1) go to 30
- if (i .eq. 2) go to 40
-c
-c *** check validity of iv and v input values ***
-c
- if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v)
- if (iv(1) .eq. 12 .or. iv(1) .eq. 13)
- 1 iv(vneed) = iv(vneed) + n*(n+21)/2 + 7
- call parck(2, d, iv, liv, lv, n, v)
- i = iv(1) - 2
- if (i .gt. 12) go to 999
- nn1o2 = n * (n + 1) / 2
- if (lh .ge. nn1o2) go to (210,210,210,210,210,210,160,120,160,
- 1 10,10,20), i
- iv(1) = 66
- go to 350
-c
-c *** storage allocation ***
-c
- 10 iv(dtol) = iv(lmat) + nn1o2
- iv(x0) = iv(dtol) + 2*n
- iv(step) = iv(x0) + n
- iv(stlstg) = iv(step) + n
- iv(dg) = iv(stlstg) + n
- iv(w) = iv(dg) + n
- iv(nextv) = iv(w) + 4*n + 7
- if (iv(1) .ne. 13) go to 20
- iv(1) = 14
- go to 999
-c
-c *** initialization ***
-c
- 20 iv(niter) = 0
- iv(nfcall) = 1
- iv(ngcall) = 1
- iv(nfgcal) = 1
- iv(mode) = -1
- iv(model) = 1
- iv(stglim) = 1
- iv(toobig) = 0
- iv(cnvcod) = 0
- iv(radinc) = 0
- v(rad0) = zero
- v(stppar) = zero
- if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit))
- k = iv(dtol)
- if (v(dtinit) .gt. zero) call vscopy(n, v(k), v(dtinit))
- k = k + n
- if (v(d0init) .gt. zero) call vscopy(n, v(k), v(d0init))
- iv(1) = 1
- go to 999
-c
- 30 v(f) = fx
- if (iv(mode) .ge. 0) go to 210
- iv(1) = 2
- if (iv(toobig) .eq. 0) go to 999
- iv(1) = 63
- go to 350
-c
-c *** make sure gradient could be computed ***
-c
- 40 if (iv(nfgcal) .ne. 0) go to 50
- iv(1) = 65
- go to 350
-c
-c *** update the scale vector d ***
-c
- 50 dg1 = iv(dg)
- if (iv(dtype) .le. 0) go to 70
- k = dg1
- j = 0
- do 60 i = 1, n
- j = j + i
- v(k) = h(j)
- k = k + 1
- 60 continue
- call dupdu(d, v(dg1), iv, liv, lv, n, v)
-c
-c *** compute scaled gradient and its norm ***
-c
- 70 dg1 = iv(dg)
- k = dg1
- do 80 i = 1, n
- v(k) = g(i) / d(i)
- k = k + 1
- 80 continue
- v(dgnorm) = v2norm(n, v(dg1))
-c
-c *** compute scaled hessian ***
-c
- k = 1
- do 100 i = 1, n
- t = one / d(i)
- do 90 j = 1, i
- h(k) = t * h(k) / d(j)
- k = k + 1
- 90 continue
- 100 continue
-c
- if (iv(cnvcod) .ne. 0) go to 340
- if (iv(mode) .eq. 0) go to 300
-c
-c *** allow first step to have scaled 2-norm at most v(lmax0) ***
-c
- v(radius) = v(lmax0)
-c
- iv(mode) = 0
-c
-c
-c----------------------------- main loop -----------------------------
-c
-c
-c *** print iteration summary, check iteration limit ***
-c
- 110 call itsum(d, g, iv, liv, lv, n, v, x)
- 120 k = iv(niter)
- if (k .lt. iv(mxiter)) go to 130
- iv(1) = 10
- go to 350
-c
- 130 iv(niter) = k + 1
-c
-c *** initialize for start of next iteration ***
-c
- dg1 = iv(dg)
- x01 = iv(x0)
- v(f0) = v(f)
- iv(irc) = 4
- iv(kagqt) = -1
-c
-c *** copy x to x0 ***
-c
- call vcopy(n, v(x01), x)
-c
-c *** update radius ***
-c
- if (k .eq. 0) go to 150
- step1 = iv(step)
- k = step1
- do 140 i = 1, n
- v(k) = d(i) * v(k)
- k = k + 1
- 140 continue
- v(radius) = v(radfac) * v2norm(n, v(step1))
-c
-c *** check stopx and function evaluation limit ***
-c
-C AL 4/30/95
- dummy=iv(nfcall)
- 150 if (.not. stopx(dummy)) go to 170
- iv(1) = 11
- go to 180
-c
-c *** come here when restarting after func. eval. limit or stopx.
-c
- 160 if (v(f) .ge. v(f0)) go to 170
- v(radfac) = one
- k = iv(niter)
- go to 130
-c
- 170 if (iv(nfcall) .lt. iv(mxfcal)) go to 190
- iv(1) = 9
- 180 if (v(f) .ge. v(f0)) go to 350
-c
-c *** in case of stopx or function evaluation limit with
-c *** improved v(f), evaluate the gradient at x.
-c
- iv(cnvcod) = iv(1)
- go to 290
-c
-c. . . . . . . . . . . . . compute candidate step . . . . . . . . . .
-c
- 190 step1 = iv(step)
- dg1 = iv(dg)
- l = iv(lmat)
- w1 = iv(w)
- call gqtst(d, v(dg1), h, iv(kagqt), v(l), n, v(step1), v, v(w1))
- if (iv(irc) .eq. 6) go to 210
-c
-c *** check whether evaluating f(x0 + step) looks worthwhile ***
-c
- if (v(dstnrm) .le. zero) go to 210
- if (iv(irc) .ne. 5) go to 200
- if (v(radfac) .le. one) go to 200
- if (v(preduc) .le. onep2 * v(fdif)) go to 210
-c
-c *** compute f(x0 + step) ***
-c
- 200 x01 = iv(x0)
- step1 = iv(step)
- call vaxpy(n, x, one, v(step1), v(x01))
- iv(nfcall) = iv(nfcall) + 1
- iv(1) = 1
- iv(toobig) = 0
- go to 999
-c
-c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . .
-c
- 210 x01 = iv(x0)
- v(reldx) = reldst(n, d, x, v(x01))
- call assst(iv, liv, lv, v)
- step1 = iv(step)
- lstgst = iv(stlstg)
- if (iv(restor) .eq. 1) call vcopy(n, x, v(x01))
- if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1))
- if (iv(restor) .ne. 3) go to 220
- call vcopy(n, v(step1), v(lstgst))
- call vaxpy(n, x, one, v(step1), v(x01))
- v(reldx) = reldst(n, d, x, v(x01))
-c
- 220 k = iv(irc)
- go to (230,260,260,260,230,240,250,250,250,250,250,250,330,300), k
-c
-c *** recompute step with new radius ***
-c
- 230 v(radius) = v(radfac) * v(dstnrm)
- go to 150
-c
-c *** compute step of length v(lmaxs) for singular convergence test.
-c
- 240 v(radius) = v(lmaxs)
- go to 190
-c
-c *** convergence or false convergence ***
-c
- 250 iv(cnvcod) = k - 4
- if (v(f) .ge. v(f0)) go to 340
- if (iv(xirc) .eq. 14) go to 340
- iv(xirc) = 14
-c
-c. . . . . . . . . . . . process acceptable step . . . . . . . . . . .
-c
- 260 if (iv(irc) .ne. 3) go to 290
- temp1 = lstgst
-c
-c *** prepare for gradient tests ***
-c *** set temp1 = hessian * step + g(x0)
-c *** = diag(d) * (h * step + g(x0))
-c
-c use x0 vector as temporary.
- k = x01
- do 270 i = 1, n
- v(k) = d(i) * v(step1)
- k = k + 1
- step1 = step1 + 1
- 270 continue
- call slvmul(n, v(temp1), h, v(x01))
- do 280 i = 1, n
- v(temp1) = d(i) * v(temp1) + g(i)
- temp1 = temp1 + 1
- 280 continue
-c
-c *** compute gradient and hessian ***
-c
- 290 iv(ngcall) = iv(ngcall) + 1
- iv(1) = 2
- go to 999
-c
- 300 iv(1) = 2
- if (iv(irc) .ne. 3) go to 110
-c
-c *** set v(radfac) by gradient tests ***
-c
- temp1 = iv(stlstg)
- step1 = iv(step)
-c
-c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) ***
-c
- k = temp1
- do 310 i = 1, n
- v(k) = (v(k) - g(i)) / d(i)
- k = k + 1
- 310 continue
-c
-c *** do gradient tests ***
-c
- if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4)) go to 320
- if (dotprd(n, g, v(step1))
- 1 .ge. v(gtstep) * v(tuner5)) go to 110
- 320 v(radfac) = v(incfac)
- go to 110
-c
-c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . .
-c
-c *** bad parameters to assess ***
-c
- 330 iv(1) = 64
- go to 350
-c
-c *** print summary of final iteration and other requested items ***
-c
- 340 iv(1) = iv(cnvcod)
- iv(cnvcod) = 0
- 350 call itsum(d, g, iv, liv, lv, n, v, x)
-c
- 999 return
-c
-c *** last card of humit follows ***
- end
- subroutine dupdu(d, hdiag, iv, liv, lv, n, v)
-c
-c *** update scale vector d for humsl ***
-c
-c *** parameter declarations ***
-c
- integer liv, lv, n
- integer iv(liv)
- double precision d(n), hdiag(n), v(lv)
-c
-c *** local variables ***
-c
- integer dtoli, d0i, i
- double precision t, vdfac
-c
-c *** intrinsic functions ***
-c/+
- double precision dabs, dmax1, dsqrt
-c/
-c *** subscripts for iv and v ***
-c
- integer dfac, dtol, dtype, niter
-c/6
-c data dfac/41/, dtol/59/, dtype/16/, niter/31/
-c/7
- parameter (dfac=41, dtol=59, dtype=16, niter=31)
-c/
-c
-c------------------------------- body --------------------------------
-c
- i = iv(dtype)
- if (i .eq. 1) go to 10
- if (iv(niter) .gt. 0) go to 999
-c
- 10 dtoli = iv(dtol)
- d0i = dtoli + n
- vdfac = v(dfac)
- do 20 i = 1, n
- t = dmax1(dsqrt(dabs(hdiag(i))), vdfac*d(i))
- if (t .lt. v(dtoli)) t = dmax1(v(dtoli), v(d0i))
- d(i) = t
- dtoli = dtoli + 1
- d0i = d0i + 1
- 20 continue
-c
- 999 return
-c *** last card of dupdu follows ***
- end
- subroutine gqtst(d, dig, dihdi, ka, l, p, step, v, w)
-c
-c *** compute goldfeld-quandt-trotter step by more-hebden technique ***
-c *** (nl2sol version 2.2), modified a la more and sorensen ***
-c
-c *** parameter declarations ***
-c
- integer ka, p
-cal double precision d(p), dig(p), dihdi(1), l(1), v(21), step(p),
-cal 1 w(1)
- double precision d(p), dig(p), dihdi(p*(p+1)/2), l(p*(p+1)/2),
- 1 v(21), step(p),w(4*p+7)
-c dimension dihdi(p*(p+1)/2), l(p*(p+1)/2), w(4*p+7)
-c
-c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-c
-c *** purpose ***
-c
-c given the (compactly stored) lower triangle of a scaled
-c hessian (approximation) and a nonzero scaled gradient vector,
-c this subroutine computes a goldfeld-quandt-trotter step of
-c approximate length v(radius) by the more-hebden technique. in
-c other words, step is computed to (approximately) minimize
-c psi(step) = (g**t)*step + 0.5*(step**t)*h*step such that the
-c 2-norm of d*step is at most (approximately) v(radius), where
-c g is the gradient, h is the hessian, and d is a diagonal
-c scale matrix whose diagonal is stored in the parameter d.
-c (gqtst assumes dig = d**-1 * g and dihdi = d**-1 * h * d**-1.)
-c
-c *** parameter description ***
-c
-c d (in) = the scale vector, i.e. the diagonal of the scale
-c matrix d mentioned above under purpose.
-c dig (in) = the scaled gradient vector, d**-1 * g. if g = 0, then
-c step = 0 and v(stppar) = 0 are returned.
-c dihdi (in) = lower triangle of the scaled hessian (approximation),
-c i.e., d**-1 * h * d**-1, stored compactly by rows., i.e.,
-c in the order (1,1), (2,1), (2,2), (3,1), (3,2), etc.
-c ka (i/o) = the number of hebden iterations (so far) taken to deter-
-c mine step. ka .lt. 0 on input means this is the first
-c attempt to determine step (for the present dig and dihdi)
-c -- ka is initialized to 0 in this case. output with
-c ka = 0 (or v(stppar) = 0) means step = -(h**-1)*g.
-c l (i/o) = workspace of length p*(p+1)/2 for cholesky factors.
-c p (in) = number of parameters -- the hessian is a p x p matrix.
-c step (i/o) = the step computed.
-c v (i/o) contains various constants and variables described below.
-c w (i/o) = workspace of length 4*p + 6.
-c
-c *** entries in v ***
-c
-c v(dgnorm) (i/o) = 2-norm of (d**-1)*g.
-c v(dstnrm) (output) = 2-norm of d*step.
-c v(dst0) (i/o) = 2-norm of d*(h**-1)*g (for pos. def. h only), or
-c overestimate of smallest eigenvalue of (d**-1)*h*(d**-1).
-c v(epslon) (in) = max. rel. error allowed for psi(step). for the
-c step returned, psi(step) will exceed its optimal value
-c by less than -v(epslon)*psi(step). suggested value = 0.1.
-c v(gtstep) (out) = inner product between g and step.
-c v(nreduc) (out) = psi(-(h**-1)*g) = psi(newton step) (for pos. def.
-c h only -- v(nreduc) is set to zero otherwise).
-c v(phmnfc) (in) = tol. (together with v(phmxfc)) for accepting step
-c (more*s sigma). the error v(dstnrm) - v(radius) must lie
-c between v(phmnfc)*v(radius) and v(phmxfc)*v(radius).
-c v(phmxfc) (in) (see v(phmnfc).)
-c suggested values -- v(phmnfc) = -0.25, v(phmxfc) = 0.5.
-c v(preduc) (out) = psi(step) = predicted obj. func. reduction for step.
-c v(radius) (in) = radius of current (scaled) trust region.
-c v(rad0) (i/o) = value of v(radius) from previous call.
-c v(stppar) (i/o) is normally the marquardt parameter, i.e. the alpha
-c described below under algorithm notes. if h + alpha*d**2
-c (see algorithm notes) is (nearly) singular, however,
-c then v(stppar) = -alpha.
-c
-c *** usage notes ***
-c
-c if it is desired to recompute step using a different value of
-c v(radius), then this routine may be restarted by calling it
-c with all parameters unchanged except v(radius). (this explains
-c why step and w are listed as i/o). on an initial call (one with
-c ka .lt. 0), step and w need not be initialized and only compo-
-c nents v(epslon), v(stppar), v(phmnfc), v(phmxfc), v(radius), and
-c v(rad0) of v must be initialized.
-c
-c *** algorithm notes ***
-c
-c the desired g-q-t step (ref. 2, 3, 4, 6) satisfies
-c (h + alpha*d**2)*step = -g for some nonnegative alpha such that
-c h + alpha*d**2 is positive semidefinite. alpha and step are
-c computed by a scheme analogous to the one described in ref. 5.
-c estimates of the smallest and largest eigenvalues of the hessian
-c are obtained from the gerschgorin circle theorem enhanced by a
-c simple form of the scaling described in ref. 7. cases in which
-c h + alpha*d**2 is nearly (or exactly) singular are handled by
-c the technique discussed in ref. 2. in these cases, a step of
-c (exact) length v(radius) is returned for which psi(step) exceeds
-c its optimal value by less than -v(epslon)*psi(step). the test
-c suggested in ref. 6 for detecting the special case is performed
-c once two matrix factorizations have been done -- doing so sooner
-c seems to degrade the performance of optimization routines that
-c call this routine.
-c
-c *** functions and subroutines called ***
-c
-c dotprd - returns inner product of two vectors.
-c litvmu - applies inverse-transpose of compact lower triang. matrix.
-c livmul - applies inverse of compact lower triang. matrix.
-c lsqrt - finds cholesky factor (of compactly stored lower triang.).
-c lsvmin - returns approx. to min. sing. value of lower triang. matrix.
-c rmdcon - returns machine-dependent constants.
-c v2norm - returns 2-norm of a vector.
-c
-c *** references ***
-c
-c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), an adaptive
-c nonlinear least-squares algorithm, acm trans. math.
-c software, vol. 7, no. 3.
-c 2. gay, d.m. (1981), computing optimal locally constrained steps,
-c siam j. sci. statist. computing, vol. 2, no. 2, pp.
-c 186-197.
-c 3. goldfeld, s.m., quandt, r.e., and trotter, h.f. (1966),
-c maximization by quadratic hill-climbing, econometrica 34,
-c pp. 541-551.
-c 4. hebden, m.d. (1973), an algorithm for minimization using exact
-c second derivatives, report t.p. 515, theoretical physics
-c div., a.e.r.e. harwell, oxon., england.
-c 5. more, j.j. (1978), the levenberg-marquardt algorithm, implemen-
-c tation and theory, pp.105-116 of springer lecture notes
-c in mathematics no. 630, edited by g.a. watson, springer-
-c verlag, berlin and new york.
-c 6. more, j.j., and sorensen, d.c. (1981), computing a trust region
-c step, technical report anl-81-83, argonne national lab.
-c 7. varga, r.s. (1965), minimal gerschgorin sets, pacific j. math. 15,
-c pp. 719-729.
-c
-c *** general ***
-c
-c coded by david m. gay.
-c this subroutine was written in connection with research
-c supported by the national science foundation under grants
-c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and
-c mcs-7906671.
-c
-c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-c
-c *** local variables ***
-c
- logical restrt
- integer dggdmx, diag, diag0, dstsav, emax, emin, i, im1, inc, irc,
- 1 j, k, kalim, kamin, k1, lk0, phipin, q, q0, uk0, x
- double precision alphak, aki, akk, delta, dst, eps, gtsta, lk,
- 1 oldphi, phi, phimax, phimin, psifac, rad, radsq,
- 2 root, si, sk, sw, t, twopsi, t1, t2, uk, wi
-c
-c *** constants ***
- double precision big, dgxfac, epsfac, four, half, kappa, negone,
- 1 one, p001, six, three, two, zero
-c
-c *** intrinsic functions ***
-c/+
- double precision dabs, dmax1, dmin1, dsqrt
-c/
-c *** external functions and subroutines ***
-c
- external dotprd, litvmu, livmul, lsqrt, lsvmin, rmdcon, v2norm
- double precision dotprd, lsvmin, rmdcon, v2norm
-c
-c *** subscripts for v ***
-c
- integer dgnorm, dstnrm, dst0, epslon, gtstep, stppar, nreduc,
- 1 phmnfc, phmxfc, preduc, radius, rad0
-c/6
-c data dgnorm/1/, dstnrm/2/, dst0/3/, epslon/19/, gtstep/4/,
-c 1 nreduc/6/, phmnfc/20/, phmxfc/21/, preduc/7/, radius/8/,
-c 2 rad0/9/, stppar/5/
-c/7
- parameter (dgnorm=1, dstnrm=2, dst0=3, epslon=19, gtstep=4,
- 1 nreduc=6, phmnfc=20, phmxfc=21, preduc=7, radius=8,
- 2 rad0=9, stppar=5)
-c/
-c
-c/6
-c data epsfac/50.0d+0/, four/4.0d+0/, half/0.5d+0/,
-c 1 kappa/2.0d+0/, negone/-1.0d+0/, one/1.0d+0/, p001/1.0d-3/,
-c 2 six/6.0d+0/, three/3.0d+0/, two/2.0d+0/, zero/0.0d+0/
-c/7
- parameter (epsfac=50.0d+0, four=4.0d+0, half=0.5d+0,
- 1 kappa=2.0d+0, negone=-1.0d+0, one=1.0d+0, p001=1.0d-3,
- 2 six=6.0d+0, three=3.0d+0, two=2.0d+0, zero=0.0d+0)
- save dgxfac
-c/
- data big/0.d+0/, dgxfac/0.d+0/
-c
-c *** body ***
-c
-c *** store largest abs. entry in (d**-1)*h*(d**-1) at w(dggdmx).
- dggdmx = p + 1
-c *** store gerschgorin over- and underestimates of the largest
-c *** and smallest eigenvalues of (d**-1)*h*(d**-1) at w(emax)
-c *** and w(emin) respectively.
- emax = dggdmx + 1
- emin = emax + 1
-c *** for use in recomputing step, the final values of lk, uk, dst,
-c *** and the inverse derivative of more*s phi at 0 (for pos. def.
-c *** h) are stored in w(lk0), w(uk0), w(dstsav), and w(phipin)
-c *** respectively.
- lk0 = emin + 1
- phipin = lk0 + 1
- uk0 = phipin + 1
- dstsav = uk0 + 1
-c *** store diag of (d**-1)*h*(d**-1) in w(diag),...,w(diag0+p).
- diag0 = dstsav
- diag = diag0 + 1
-c *** store -d*step in w(q),...,w(q0+p).
- q0 = diag0 + p
- q = q0 + 1
-c *** allocate storage for scratch vector x ***
- x = q + p
- rad = v(radius)
- radsq = rad**2
-c *** phitol = max. error allowed in dst = v(dstnrm) = 2-norm of
-c *** d*step.
- phimax = v(phmxfc) * rad
- phimin = v(phmnfc) * rad
- psifac = two * v(epslon) / (three * (four * (v(phmnfc) + one) *
- 1 (kappa + one) + kappa + two) * rad**2)
-c *** oldphi is used to detect limits of numerical accuracy. if
-c *** we recompute step and it does not change, then we accept it.
- oldphi = zero
- eps = v(epslon)
- irc = 0
- restrt = .false.
- kalim = ka + 50
-c
-c *** start or restart, depending on ka ***
-c
- if (ka .ge. 0) go to 290
-c
-c *** fresh start ***
-c
- k = 0
- uk = negone
- ka = 0
- kalim = 50
- v(dgnorm) = v2norm(p, dig)
- v(nreduc) = zero
- v(dst0) = zero
- kamin = 3
- if (v(dgnorm) .eq. zero) kamin = 0
-c
-c *** store diag(dihdi) in w(diag0+1),...,w(diag0+p) ***
-c
- j = 0
- do 10 i = 1, p
- j = j + i
- k1 = diag0 + i
- w(k1) = dihdi(j)
- 10 continue
-c
-c *** determine w(dggdmx), the largest element of dihdi ***
-c
- t1 = zero
- j = p * (p + 1) / 2
- do 20 i = 1, j
- t = dabs(dihdi(i))
- if (t1 .lt. t) t1 = t
- 20 continue
- w(dggdmx) = t1
-c
-c *** try alpha = 0 ***
-c
- 30 call lsqrt(1, p, l, dihdi, irc)
- if (irc .eq. 0) go to 50
-c *** indef. h -- underestimate smallest eigenvalue, use this
-c *** estimate to initialize lower bound lk on alpha.
- j = irc*(irc+1)/2
- t = l(j)
- l(j) = one
- do 40 i = 1, irc
- 40 w(i) = zero
- w(irc) = one
- call litvmu(irc, w, l, w)
- t1 = v2norm(irc, w)
- lk = -t / t1 / t1
- v(dst0) = -lk
- if (restrt) go to 210
- go to 70
-c
-c *** positive definite h -- compute unmodified newton step. ***
- 50 lk = zero
- t = lsvmin(p, l, w(q), w(q))
- if (t .ge. one) go to 60
- if (big .le. zero) big = rmdcon(6)
- if (v(dgnorm) .ge. t*t*big) go to 70
- 60 call livmul(p, w(q), l, dig)
- gtsta = dotprd(p, w(q), w(q))
- v(nreduc) = half * gtsta
- call litvmu(p, w(q), l, w(q))
- dst = v2norm(p, w(q))
- v(dst0) = dst
- phi = dst - rad
- if (phi .le. phimax) go to 260
- if (restrt) go to 210
-c
-c *** prepare to compute gerschgorin estimates of largest (and
-c *** smallest) eigenvalues. ***
-c
- 70 k = 0
- do 100 i = 1, p
- wi = zero
- if (i .eq. 1) go to 90
- im1 = i - 1
- do 80 j = 1, im1
- k = k + 1
- t = dabs(dihdi(k))
- wi = wi + t
- w(j) = w(j) + t
- 80 continue
- 90 w(i) = wi
- k = k + 1
- 100 continue
-c
-c *** (under-)estimate smallest eigenvalue of (d**-1)*h*(d**-1) ***
-c
- k = 1
- t1 = w(diag) - w(1)
- if (p .le. 1) go to 120
- do 110 i = 2, p
- j = diag0 + i
- t = w(j) - w(i)
- if (t .ge. t1) go to 110
- t1 = t
- k = i
- 110 continue
-c
- 120 sk = w(k)
- j = diag0 + k
- akk = w(j)
- k1 = k*(k-1)/2 + 1
- inc = 1
- t = zero
- do 150 i = 1, p
- if (i .eq. k) go to 130
- aki = dabs(dihdi(k1))
- si = w(i)
- j = diag0 + i
- t1 = half * (akk - w(j) + si - aki)
- t1 = t1 + dsqrt(t1*t1 + sk*aki)
- if (t .lt. t1) t = t1
- if (i .lt. k) go to 140
- 130 inc = i
- 140 k1 = k1 + inc
- 150 continue
-c
- w(emin) = akk - t
- uk = v(dgnorm)/rad - w(emin)
- if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk
- if (uk .le. zero) uk = p001
-c
-c *** compute gerschgorin (over-)estimate of largest eigenvalue ***
-c
- k = 1
- t1 = w(diag) + w(1)
- if (p .le. 1) go to 170
- do 160 i = 2, p
- j = diag0 + i
- t = w(j) + w(i)
- if (t .le. t1) go to 160
- t1 = t
- k = i
- 160 continue
-c
- 170 sk = w(k)
- j = diag0 + k
- akk = w(j)
- k1 = k*(k-1)/2 + 1
- inc = 1
- t = zero
- do 200 i = 1, p
- if (i .eq. k) go to 180
- aki = dabs(dihdi(k1))
- si = w(i)
- j = diag0 + i
- t1 = half * (w(j) + si - aki - akk)
- t1 = t1 + dsqrt(t1*t1 + sk*aki)
- if (t .lt. t1) t = t1
- if (i .lt. k) go to 190
- 180 inc = i
- 190 k1 = k1 + inc
- 200 continue
-c
- w(emax) = akk + t
- lk = dmax1(lk, v(dgnorm)/rad - w(emax))
-c
-c *** alphak = current value of alpha (see alg. notes above). we
-c *** use more*s scheme for initializing it.
- alphak = dabs(v(stppar)) * v(rad0)/rad
-c
- if (irc .ne. 0) go to 210
-c
-c *** compute l0 for positive definite h ***
-c
- call livmul(p, w, l, w(q))
- t = v2norm(p, w)
- w(phipin) = dst / t / t
- lk = dmax1(lk, phi*w(phipin))
-c
-c *** safeguard alphak and add alphak*i to (d**-1)*h*(d**-1) ***
-c
- 210 ka = ka + 1
- if (-v(dst0) .ge. alphak .or. alphak .lt. lk .or. alphak .ge. uk)
- 1 alphak = uk * dmax1(p001, dsqrt(lk/uk))
- if (alphak .le. zero) alphak = half * uk
- if (alphak .le. zero) alphak = uk
- k = 0
- do 220 i = 1, p
- k = k + i
- j = diag0 + i
- dihdi(k) = w(j) + alphak
- 220 continue
-c
-c *** try computing cholesky decomposition ***
-c
- call lsqrt(1, p, l, dihdi, irc)
- if (irc .eq. 0) go to 240
-c
-c *** (d**-1)*h*(d**-1) + alphak*i is indefinite -- overestimate
-c *** smallest eigenvalue for use in updating lk ***
-c
- j = (irc*(irc+1))/2
- t = l(j)
- l(j) = one
- do 230 i = 1, irc
- 230 w(i) = zero
- w(irc) = one
- call litvmu(irc, w, l, w)
- t1 = v2norm(irc, w)
- lk = alphak - t/t1/t1
- v(dst0) = -lk
- go to 210
-c
-c *** alphak makes (d**-1)*h*(d**-1) positive definite.
-c *** compute q = -d*step, check for convergence. ***
-c
- 240 call livmul(p, w(q), l, dig)
- gtsta = dotprd(p, w(q), w(q))
- call litvmu(p, w(q), l, w(q))
- dst = v2norm(p, w(q))
- phi = dst - rad
- if (phi .le. phimax .and. phi .ge. phimin) go to 270
- if (phi .eq. oldphi) go to 270
- oldphi = phi
- if (phi .lt. zero) go to 330
-c
-c *** unacceptable alphak -- update lk, uk, alphak ***
-c
- 250 if (ka .ge. kalim) go to 270
-c *** the following dmin1 is necessary because of restarts ***
- if (phi .lt. zero) uk = dmin1(uk, alphak)
-c *** kamin = 0 only iff the gradient vanishes ***
- if (kamin .eq. 0) go to 210
- call livmul(p, w, l, w(q))
- t1 = v2norm(p, w)
- alphak = alphak + (phi/t1) * (dst/t1) * (dst/rad)
- lk = dmax1(lk, alphak)
- go to 210
-c
-c *** acceptable step on first try ***
-c
- 260 alphak = zero
-c
-c *** successful step in general. compute step = -(d**-1)*q ***
-c
- 270 do 280 i = 1, p
- j = q0 + i
- step(i) = -w(j)/d(i)
- 280 continue
- v(gtstep) = -gtsta
- v(preduc) = half * (dabs(alphak)*dst*dst + gtsta)
- go to 410
-c
-c
-c *** restart with new radius ***
-c
- 290 if (v(dst0) .le. zero .or. v(dst0) - rad .gt. phimax) go to 310
-c
-c *** prepare to return newton step ***
-c
- restrt = .true.
- ka = ka + 1
- k = 0
- do 300 i = 1, p
- k = k + i
- j = diag0 + i
- dihdi(k) = w(j)
- 300 continue
- uk = negone
- go to 30
-c
- 310 kamin = ka + 3
- if (v(dgnorm) .eq. zero) kamin = 0
- if (ka .eq. 0) go to 50
-c
- dst = w(dstsav)
- alphak = dabs(v(stppar))
- phi = dst - rad
- t = v(dgnorm)/rad
- uk = t - w(emin)
- if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk
- if (uk .le. zero) uk = p001
- if (rad .gt. v(rad0)) go to 320
-c
-c *** smaller radius ***
- lk = zero
- if (alphak .gt. zero) lk = w(lk0)
- lk = dmax1(lk, t - w(emax))
- if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin))
- go to 250
-c
-c *** bigger radius ***
- 320 if (alphak .gt. zero) uk = dmin1(uk, w(uk0))
- lk = dmax1(zero, -v(dst0), t - w(emax))
- if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin))
- go to 250
-c
-c *** decide whether to check for special case... in practice (from
-c *** the standpoint of the calling optimization code) it seems best
-c *** not to check until a few iterations have failed -- hence the
-c *** test on kamin below.
-c
- 330 delta = alphak + dmin1(zero, v(dst0))
- twopsi = alphak*dst*dst + gtsta
- if (ka .ge. kamin) go to 340
-c *** if the test in ref. 2 is satisfied, fall through to handle
-c *** the special case (as soon as the more-sorensen test detects
-c *** it).
- if (delta .ge. psifac*twopsi) go to 370
-c
-c *** check for the special case of h + alpha*d**2 (nearly)
-c *** singular. use one step of inverse power method with start
-c *** from lsvmin to obtain approximate eigenvector corresponding
-c *** to smallest eigenvalue of (d**-1)*h*(d**-1). lsvmin returns
-c *** x and w with l*w = x.
-c
- 340 t = lsvmin(p, l, w(x), w)
-c
-c *** normalize w ***
- do 350 i = 1, p
- 350 w(i) = t*w(i)
-c *** complete current inv. power iter. -- replace w by (l**-t)*w.
- call litvmu(p, w, l, w)
- t2 = one/v2norm(p, w)
- do 360 i = 1, p
- 360 w(i) = t2*w(i)
- t = t2 * t
-c
-c *** now w is the desired approximate (unit) eigenvector and
-c *** t*x = ((d**-1)*h*(d**-1) + alphak*i)*w.
-c
- sw = dotprd(p, w(q), w)
- t1 = (rad + dst) * (rad - dst)
- root = dsqrt(sw*sw + t1)
- if (sw .lt. zero) root = -root
- si = t1 / (sw + root)
-c
-c *** the actual test for the special case...
-c
- if ((t2*si)**2 .le. eps*(dst**2 + alphak*radsq)) go to 380
-c
-c *** update upper bound on smallest eigenvalue (when not positive)
-c *** (as recommended by more and sorensen) and continue...
-c
- if (v(dst0) .le. zero) v(dst0) = dmin1(v(dst0), t2**2 - alphak)
- lk = dmax1(lk, -v(dst0))
-c
-c *** check whether we can hope to detect the special case in
-c *** the available arithmetic. accept step as it is if not.
-c
-c *** if not yet available, obtain machine dependent value dgxfac.
- 370 if (dgxfac .eq. zero) dgxfac = epsfac * rmdcon(3)
-c
- if (delta .gt. dgxfac*w(dggdmx)) go to 250
- go to 270
-c
-c *** special case detected... negate alphak to indicate special case
-c
- 380 alphak = -alphak
- v(preduc) = half * twopsi
-c
-c *** accept current step if adding si*w would lead to a
-c *** further relative reduction in psi of less than v(epslon)/3.
-c
- t1 = zero
- t = si*(alphak*sw - half*si*(alphak + t*dotprd(p,w(x),w)))
- if (t .lt. eps*twopsi/six) go to 390
- v(preduc) = v(preduc) + t
- dst = rad
- t1 = -si
- 390 do 400 i = 1, p
- j = q0 + i
- w(j) = t1*w(i) - w(j)
- step(i) = w(j) / d(i)
- 400 continue
- v(gtstep) = dotprd(p, dig, w(q))
-c
-c *** save values for use in a possible restart ***
-c
- 410 v(dstnrm) = dst
- v(stppar) = alphak
- w(lk0) = lk
- w(uk0) = uk
- v(rad0) = rad
- w(dstsav) = dst
-c
-c *** restore diagonal of dihdi ***
-c
- j = 0
- do 420 i = 1, p
- j = j + i
- k = diag0 + i
- dihdi(j) = w(k)
- 420 continue
-c
- 999 return
-c
-c *** last card of gqtst follows ***
- end
- subroutine lsqrt(n1, n, l, a, irc)
-c
-c *** compute rows n1 through n of the cholesky factor l of
-c *** a = l*(l**t), where l and the lower triangle of a are both
-c *** stored compactly by rows (and may occupy the same storage).
-c *** irc = 0 means all went well. irc = j means the leading
-c *** principal j x j submatrix of a is not positive definite --
-c *** and l(j*(j+1)/2) contains the (nonpos.) reduced j-th diagonal.
-c
-c *** parameters ***
-c
- integer n1, n, irc
-cal double precision l(1), a(1)
- double precision l(n*(n+1)/2), a(n*(n+1)/2)
-c dimension l(n*(n+1)/2), a(n*(n+1)/2)
-c
-c *** local variables ***
-c
- integer i, ij, ik, im1, i0, j, jk, jm1, j0, k
- double precision t, td, zero
-c
-c *** intrinsic functions ***
-c/+
- double precision dsqrt
-c/
-c/6
-c data zero/0.d+0/
-c/7
- parameter (zero=0.d+0)
-c/
-c
-c *** body ***
-c
- i0 = n1 * (n1 - 1) / 2
- do 50 i = n1, n
- td = zero
- if (i .eq. 1) go to 40
- j0 = 0
- im1 = i - 1
- do 30 j = 1, im1
- t = zero
- if (j .eq. 1) go to 20
- jm1 = j - 1
- do 10 k = 1, jm1
- ik = i0 + k
- jk = j0 + k
- t = t + l(ik)*l(jk)
- 10 continue
- 20 ij = i0 + j
- j0 = j0 + j
- t = (a(ij) - t) / l(j0)
- l(ij) = t
- td = td + t*t
- 30 continue
- 40 i0 = i0 + i
- t = a(i0) - td
- if (t .le. zero) go to 60
- l(i0) = dsqrt(t)
- 50 continue
-c
- irc = 0
- go to 999
-c
- 60 l(i0) = t
- irc = i
-c
- 999 return
-c
-c *** last card of lsqrt ***
- end
- double precision function lsvmin(p, l, x, y)
-c
-c *** estimate smallest sing. value of packed lower triang. matrix l
-c
-c *** parameter declarations ***
-c
- integer p
-cal double precision l(1), x(p), y(p)
- double precision l(p*(p+1)/2), x(p), y(p)
-c dimension l(p*(p+1)/2)
-c
-c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-c
-c *** purpose ***
-c
-c this function returns a good over-estimate of the smallest
-c singular value of the packed lower triangular matrix l.
-c
-c *** parameter description ***
-c
-c p (in) = the order of l. l is a p x p lower triangular matrix.
-c l (in) = array holding the elements of l in row order, i.e.
-c l(1,1), l(2,1), l(2,2), l(3,1), l(3,2), l(3,3), etc.
-c x (out) if lsvmin returns a positive value, then x is a normalized
-c approximate left singular vector corresponding to the
-c smallest singular value. this approximation may be very
-c crude. if lsvmin returns zero, then some components of x
-c are zero and the rest retain their input values.
-c y (out) if lsvmin returns a positive value, then y = (l**-1)*x is an
-c unnormalized approximate right singular vector correspond-
-c ing to the smallest singular value. this approximation
-c may be crude. if lsvmin returns zero, then y retains its
-c input value. the caller may pass the same vector for x
-c and y (nonstandard fortran usage), in which case y over-
-c writes x (for nonzero lsvmin returns).
-c
-c *** algorithm notes ***
-c
-c the algorithm is based on (1), with the additional provision that
-c lsvmin = 0 is returned if the smallest diagonal element of l
-c (in magnitude) is not more than the unit roundoff times the
-c largest. the algorithm uses a random number generator proposed
-c in (4), which passes the spectral test with flying colors -- see
-c (2) and (3).
-c
-c *** subroutines and functions called ***
-c
-c v2norm - function, returns the 2-norm of a vector.
-c
-c *** references ***
-c
-c (1) cline, a., moler, c., stewart, g., and wilkinson, j.h.(1977),
-c an estimate for the condition number of a matrix, report
-c tm-310, applied math. div., argonne national laboratory.
-c
-c (2) hoaglin, d.c. (1976), theoretical properties of congruential
-c random-number generators -- an empirical view,
-c memorandum ns-340, dept. of statistics, harvard univ.
-c
-c (3) knuth, d.e. (1969), the art of computer programming, vol. 2
-c (seminumerical algorithms), addison-wesley, reading, mass.
-c
-c (4) smith, c.s. (1971), multiplicative pseudo-random number
-c generators with prime modulus, j. assoc. comput. mach. 18,
-c pp. 586-593.
-c
-c *** history ***
-c
-c designed and coded by david m. gay (winter 1977/summer 1978).
-c
-c *** general ***
-c
-c this subroutine was written in connection with research
-c supported by the national science foundation under grants
-c mcs-7600324, dcr75-10143, 76-14311dss, and mcs76-11989.
-c
-c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-c
-c *** local variables ***
-c
- integer i, ii, ix, j, ji, jj, jjj, jm1, j0, pm1
- double precision b, sminus, splus, t, xminus, xplus
-c
-c *** constants ***
-c
- double precision half, one, r9973, zero
-c
-c *** intrinsic functions ***
-c/+
- integer mod
- real float
- double precision dabs
-c/
-c *** external functions and subroutines ***
-c
- external dotprd, v2norm, vaxpy
- double precision dotprd, v2norm
-c
-c/6
-c data half/0.5d+0/, one/1.d+0/, r9973/9973.d+0/, zero/0.d+0/
-c/7
- parameter (half=0.5d+0, one=1.d+0, r9973=9973.d+0, zero=0.d+0)
-c/
-c
-c *** body ***
-c
- ix = 2
- pm1 = p - 1
-c
-c *** first check whether to return lsvmin = 0 and initialize x ***
-c
- ii = 0
- j0 = p*pm1/2
- jj = j0 + p
- if (l(jj) .eq. zero) go to 110
- ix = mod(3432*ix, 9973)
- b = half*(one + float(ix)/r9973)
- xplus = b / l(jj)
- x(p) = xplus
- if (p .le. 1) go to 60
- do 10 i = 1, pm1
- ii = ii + i
- if (l(ii) .eq. zero) go to 110
- ji = j0 + i
- x(i) = xplus * l(ji)
- 10 continue
-c
-c *** solve (l**t)*x = b, where the components of b have randomly
-c *** chosen magnitudes in (.5,1) with signs chosen to make x large.
-c
-c do j = p-1 to 1 by -1...
- do 50 jjj = 1, pm1
- j = p - jjj
-c *** determine x(j) in this iteration. note for i = 1,2,...,j
-c *** that x(i) holds the current partial sum for row i.
- ix = mod(3432*ix, 9973)
- b = half*(one + float(ix)/r9973)
- xplus = (b - x(j))
- xminus = (-b - x(j))
- splus = dabs(xplus)
- sminus = dabs(xminus)
- jm1 = j - 1
- j0 = j*jm1/2
- jj = j0 + j
- xplus = xplus/l(jj)
- xminus = xminus/l(jj)
- if (jm1 .eq. 0) go to 30
- do 20 i = 1, jm1
- ji = j0 + i
- splus = splus + dabs(x(i) + l(ji)*xplus)
- sminus = sminus + dabs(x(i) + l(ji)*xminus)
- 20 continue
- 30 if (sminus .gt. splus) xplus = xminus
- x(j) = xplus
-c *** update partial sums ***
- if (jm1 .gt. 0) call vaxpy(jm1, x, xplus, l(j0+1), x)
- 50 continue
-c
-c *** normalize x ***
-c
- 60 t = one/v2norm(p, x)
- do 70 i = 1, p
- 70 x(i) = t*x(i)
-c
-c *** solve l*y = x and return lsvmin = 1/twonorm(y) ***
-c
- do 100 j = 1, p
- jm1 = j - 1
- j0 = j*jm1/2
- jj = j0 + j
- t = zero
- if (jm1 .gt. 0) t = dotprd(jm1, l(j0+1), y)
- y(j) = (x(j) - t) / l(jj)
- 100 continue
-c
- lsvmin = one/v2norm(p, y)
- go to 999
-c
- 110 lsvmin = zero
- 999 return
-c *** last card of lsvmin follows ***
- end
- subroutine slvmul(p, y, s, x)
-c
-c *** set y = s * x, s = p x p symmetric matrix. ***
-c *** lower triangle of s stored rowwise. ***
-c
-c *** parameter declarations ***
-c
- integer p
-cal double precision s(1), x(p), y(p)
- double precision s(p*(p+1)/2), x(p), y(p)
-c dimension s(p*(p+1)/2)
-c
-c *** local variables ***
-c
- integer i, im1, j, k
- double precision xi
-c
-c *** no intrinsic functions ***
-c
-c *** external function ***
-c
- external dotprd
- double precision dotprd
-c
-c-----------------------------------------------------------------------
-c
- j = 1
- do 10 i = 1, p
- y(i) = dotprd(i, s(j), x)
- j = j + i
- 10 continue
-c
- if (p .le. 1) go to 999
- j = 1
- do 40 i = 2, p
- xi = x(i)
- im1 = i - 1
- j = j + 1
- do 30 k = 1, im1
- y(k) = y(k) + s(j)*xi
- j = j + 1
- 30 continue
- 40 continue
-c
- 999 return
-c *** last card of slvmul follows ***
- end
+++ /dev/null
- subroutine secstrp2dihc
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.BOUNDS'
- include 'COMMON.CHAIN'
- include 'COMMON.TORCNSTR'
- include 'COMMON.IOUNITS'
- character*1 secstruc(maxres)
- COMMON/SECONDARYS/secstruc
- character*80 line
- logical errflag
- external ilen
-
-cdr call getenv_loc('SECPREDFIL',secpred)
- lenpre=ilen(prefix)
- secpred=prefix(:lenpre)//'.spred'
-
-#if defined(WINIFL) || defined(WINPGI)
- open(isecpred,file=secpred,status='old',readonly,shared)
-#elif (defined CRAY) || (defined AIX)
- open(isecpred,file=secpred,status='old',action='read')
-#elif (defined G77)
- open(isecpred,file=secpred,status='old')
-#else
- open(isecpred,file=secpred,status='old',action='read')
-#endif
-C read secondary structure prediction from JPRED here!
-! read(isecpred,'(A80)',err=100,end=100) line
-! read(line,'(f10.3)',err=110) ftors
- read(isecpred,'(f10.3)',err=110) ftors
-
- write (iout,*) 'FTORS factor =',ftors
-! initialize secstruc to any
- do i=1,nres
- secstruc(i) ='-'
- enddo
- ndih_constr=0
- ndih_nconstr=0
-
- call read_secstr_pred(isecpred,iout,errflag)
- if (errflag) then
- write(iout,*)'There is a problem with the list of secondary-',
- & 'structure prediction'
- goto 100
- endif
-C 8/13/98 Set limits to generating the dihedral angles
- do i=1,nres
- phibound(1,i)=-pi
- phibound(2,i)=pi
- enddo
-
- ii=0
- do i=1,nres
- if ( secstruc(i) .eq. 'H') then
-C Helix restraints for this residue
- ii=ii+1
- idih_constr(ii)=i
- phi0(ii) = 45.0D0*deg2rad
- drange(ii)= 5.0D0*deg2rad
- phibound(1,i) = phi0(ii)-drange(ii)
- phibound(2,i) = phi0(ii)+drange(ii)
- else if (secstruc(i) .eq. 'E') then
-C strand restraints for this residue
- ii=ii+1
- idih_constr(ii)=i
- phi0(ii) = 180.0D0*deg2rad
- drange(ii)= 5.0D0*deg2rad
- phibound(1,i) = phi0(ii)-drange(ii)
- phibound(2,i) = phi0(ii)+drange(ii)
- else
-C no restraints for this residue
- ndih_nconstr=ndih_nconstr+1
- idih_nconstr(ndih_nconstr)=i
- endif
- enddo
- ndih_constr=ii
- return
-100 continue
- write(iout,'(A30,A80)')'Error reading file SECPRED',secpred
- return
- 110 continue
- write(iout,'(A20)')'Error reading FTORS'
- return
- end
-
- subroutine read_secstr_pred(jin,jout,errors)
-
- implicit real*8 (a-h,o-z)
- INCLUDE 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- character*1 secstruc(maxres)
- COMMON/SECONDARYS/secstruc
- EXTERNAL ILEN
- character*80 line,line1,ucase
- logical errflag,errors,blankline
-
- errors=.false.
- read (jin,'(a)') line
- write (jout,'(2a)') '> ',line(1:78)
- line1=ucase(line)
-C Remember that we number full residues starting from 2, then, iseq=1 and iseq=nres
-C correspond to the end-groups. ADD to the secondary structure prediction "-" for the
-C end-groups in the input file "*.spred"
-
- iseq=1
- do while (index(line1,'$END').eq.0)
-* Override commented lines.
- ipos=1
- blankline=.false.
- do while (.not.blankline)
- line1=' '
- call mykey(line,line1,ipos,blankline,errflag)
- if (errflag) write (jout,'(2a)')
- & 'Error when reading sequence in line: ',line
- errors=errors .or. errflag
- if (.not. blankline .and. .not. errflag) then
- ipos1=2
- iend=ilen(line1)
- if (iseq.le.maxres) then
- if (line1(1:1).eq.'-' ) then
- secstruc(iseq)=line1(1:1)
- else if ( ( ucase(line1(1:1)).eq.'E' ) .or.
- & ( ucase(line1(1:1)).eq.'H' ) ) then
- secstruc(iseq)=ucase(line1(1:1))
- else
- errors=.true.
- write (jout,1010) line1(1:1), iseq
- goto 80
- endif
- else
- errors=.true.
- write (jout,1000) iseq,maxres
- goto 80
- endif
- do while (ipos1.le.iend)
-
- iseq=iseq+1
- il=1
- ipos1=ipos1+1
- if (iseq.le.maxres) then
- if (line1(ipos1-1:ipos1-1).eq.'-' ) then
- secstruc(iseq)=line1(ipos1-1:ipos1-1)
- else if((ucase(line1(ipos1-1:ipos1-1)).eq.'E').or.
- & (ucase(line1(ipos1-1:ipos1-1)).eq.'H') ) then
- secstruc(iseq)=ucase(line1(ipos1-1:ipos1-1))
- else
- errors=.true.
- write (jout,1010) line1(ipos1-1:ipos1-1), iseq
- goto 80
- endif
- else
- errors=.true.
- write (jout,1000) iseq,maxres
- goto 80
- endif
- enddo
- iseq=iseq+1
- endif
- enddo
- read (jin,'(a)') line
- write (jout,'(2a)') '> ',line(1:78)
- line1=ucase(line)
- enddo
-
-cd write (jout,'(10a8)') (sequence(i),i=1,iseq-1)
-
-cd check whether the found length of the chain is correct.
- length_of_chain=iseq-1
- if (length_of_chain .ne. nres) then
-! errors=.true.
- write (jout,'(a,i4,a,i4,a)')
- & 'Error: the number of labels specified in $SEC_STRUC_PRED ('
- & ,length_of_chain,') does not match with the number of residues ('
- & ,nres,').'
- endif
- 80 continue
-
- 1000 format('Error - the number of residues (',i4,
- & ') has exceeded maximum (',i4,').')
- 1010 format ('Error - unrecognized secondary structure label',a4,
- & ' in position',i4)
- return
- end
+++ /dev/null
- SUBROUTINE DJACOB(N,NMAX,MAXJAC,E,A,C,AII)
- IMPLICIT REAL*8 (A-H,O-Z)
-C THE JACOBI DIAGONALIZATION PROCEDURE
- COMMON INP,IOUT,IPN
- DIMENSION A(NMAX,N),C(NMAX,N),AII(150),AJJ(150)
- SIN45 = .70710678
- COS45 = .70710678
- S45SQ = 0.50
- C45SQ = 0.50
-C UNIT EIGENVECTOR MATRIX
- DO 70 I = 1,N
- DO 7 J = I,N
- A(J,I)=A(I,J)
- C(I,J) = 0.0
- 7 C(J,I) = 0.0
- 70 C(I,I) = 1.0
-C DETERMINATION OF SEARCH ARGUMENT, TEST
- AMAX = 0.0
- DO 1 I = 1,N
- DO 1 J = 1,I
- TEMPA=DABS(A(I,J))
- IF (AMAX-TEMPA) 2,1,1
- 2 AMAX = TEMPA
- 1 CONTINUE
- TEST = AMAX*E
-C SEARCH FOR LARGEST OFF DIAGONAL ELEMENT
- DO 72 IJAC=1,MAXJAC
- AIJMAX = 0.0
- DO 3 I = 2,N
- LIM = I-1
- DO 3 J = 1,LIM
- TAIJ=DABS(A(I,J))
- IF (AIJMAX-TAIJ) 4,3,3
- 4 AIJMAX = TAIJ
- IPIV = I
- JPIV = J
- 3 CONTINUE
- IF(AIJMAX-TEST)300,300,5
-C PARAMETERS FOR ROTATION
- 5 TAII = A(IPIV,IPIV)
- TAJJ = A(JPIV,JPIV)
- TAIJ = A(IPIV,JPIV)
- TMT = TAII-TAJJ
- IF(DABS(TMT/TAIJ)-1.0D-12) 60,60,6
- 60 IF(TAIJ) 10,10,11
- 6 ZAMMA=TAIJ/(2.0*TMT)
- 90 IF(DABS(ZAMMA)-0.38268)8,8,9
- 9 IF(ZAMMA)10,10,11
- 10 SINT = -SIN45
- GO TO 12
- 11 SINT = SIN45
- 12 COST = COS45
- SINSQ = S45SQ
- COSSQ = C45SQ
- GO TO 120
- 8 GAMSQ=ZAMMA*ZAMMA
- SINT=2.0*ZAMMA/(1.0+GAMSQ)
- COST = (1.0-GAMSQ)/(1.0+GAMSQ)
- SINSQ=SINT*SINT
- COSSQ=COST*COST
-C ROTATION
- 120 DO 13 K = 1,N
- TAIK = A(IPIV,K)
- TAJK = A(JPIV,K)
- A(IPIV,K) = TAIK*COST+TAJK*SINT
- A(JPIV,K) = TAJK*COST-TAIK*SINT
- TCIK = C(IPIV,K)
- TCJK = C(JPIV,K)
- C(IPIV,K) = TCIK*COST+TCJK*SINT
- 13 C(JPIV,K) = TCJK*COST-TCIK*SINT
- A(IPIV,IPIV) = TAII*COSSQ+TAJJ*SINSQ+2.0*TAIJ*SINT*COST
- A(JPIV,JPIV) = TAII*SINSQ+TAJJ*COSSQ-2.0*TAIJ*SINT*COST
- A(IPIV,JPIV) = TAIJ*(COSSQ-SINSQ)-SINT*COST*TMT
- A(JPIV,IPIV) = A(IPIV,JPIV)
- DO 30 K = 1,N
- A(K,IPIV) = A(IPIV,K)
- 30 A(K,JPIV) = A(JPIV,K)
- 72 CONTINUE
- WRITE (IOUT,1000) AIJMAX
- 1000 FORMAT (/1X,'NONCONVERGENT JACOBI. LARGEST OFF-DIAGONAL ELE',
- 1 'MENT = ',1PE14.7)
-C ARRANGEMENT OF EIGENVALUES IN ASCENDING ORDER
- 300 DO 14 I=1,N
- 14 AJJ(I)=A(I,I)
- LT=N+1
- DO15 L=1,N
- LT=LT-1
- AIIMIN=1.0E+30
- DO16 I=1,N
- IF(AJJ(I)-AIIMIN)17,16,16
- 17 AIIMIN=AJJ(I)
- IT=I
- 16 CONTINUE
- IN=L
- AII(IN)=AIIMIN
- AJJ(IT)=1.0E+30
- DO15 K=1,N
- 15 A(IN,K)=C(IT,K)
- DO 18 I=1,N
- IF(A(I,1))19,22,22
- 19 T=-1.0
- GO TO 91
- 22 T=1.0
- 91 DO 18 J=1,N
- 18 C(J,I)=T*A(I,J)
- RETURN
- END
+++ /dev/null
- subroutine Econstr_back
-c MD with umbrella_sampling using Wolyne's distance measure as a constraint
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- Uconst_back=0.0d0
- do i=1,nres
- dutheta(i)=0.0d0
- dugamma(i)=0.0d0
- do j=1,3
- duscdiff(j,i)=0.0d0
- duscdiffx(j,i)=0.0d0
- enddo
- enddo
- do i=1,nfrag_back
- ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
-c
-c Deviations from theta angles
-c
- utheta_i=0.0d0
- do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
- dtheta_i=theta(j)-thetaref(j)
- utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
- dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
- enddo
- utheta(i)=utheta_i/(ii-1)
-c
-c Deviations from gamma angles
-c
- ugamma_i=0.0d0
- do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
- dgamma_i=pinorm(phi(j)-phiref(j))
-c write (iout,*) j,phi(j),phi(j)-phiref(j)
- ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
- dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
-c write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
- enddo
- ugamma(i)=ugamma_i/(ii-2)
-c
-c Deviations from local SC geometry
-c
- uscdiff(i)=0.0d0
- do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
- dxx=xxtab(j)-xxref(j)
- dyy=yytab(j)-yyref(j)
- dzz=zztab(j)-zzref(j)
- uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
- do k=1,3
- duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)*
- & (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/
- & (ii-1)
- duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)*
- & (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/
- & (ii-1)
- duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)*
- & (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz)
- & /(ii-1)
- enddo
-c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
-c & xxref(j),yyref(j),zzref(j)
- enddo
- uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
-c write (iout,*) i," uscdiff",uscdiff(i)
-c
-c Put together deviations from local geometry
-c
- Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+
- & wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
-c write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
-c & " uconst_back",uconst_back
- utheta(i)=dsqrt(utheta(i))
- ugamma(i)=dsqrt(ugamma(i))
- uscdiff(i)=dsqrt(uscdiff(i))
- enddo
- return
- end
+++ /dev/null
-C 10 AUG 94 - MWS - INCREASE NUMBER OF DAF RECORDS
-C 31 MAR 94 - MWS - ADD A VARIABLE TO END OF MACHSW COMMON
-C 26 JUN 93 - MWS - ETRED3: ADD RETURN FOR SPECIAL CASE N=1
-C 4 JAN 92 - TLW - MAKE WRITES PARALLEL;ADD COMMON PAR
-C 30 AUG 91 - MWS - JACDIA: LIMIT ITERATIONS, USE EPSLON IN TEST.
-C 14 JUL 91 - MWS - JACOBI DIAGONALIZATION ALLOWS FOR LDVEC.NE.N
-C 29 JAN 91 - TLW - GLDIAG: CHANGED COMMON DIAGSW TO MACHSW
-C 29 OCT 90 - STE - FIX JACDIA UNDEFINED VARIABLE BUG
-C 14 SEP 90 - MK - NEW JACOBI DIAGONALIZATION (KDIAG=3)
-C 27 MAR 88 - MWS - ALLOW FOR VECTOR ROUTINE IN GLDIAG
-C 11 AUG 87 - MWS - SANITIZE CONSTANTS IN EQLRAT
-C 15 FEB 87 - STE - FIX EINVIT SUB-MATRIX LOOP LIMIT
-C SCRATCH ARRAYS ARE N*8 REAL AND N INTEGER
-C 8 DEC 86 - STE - USE PERF INDEX FROM ESTPI1 TO JUDGE EINVIT FAILURE
-C 30 NOV 86 - STE - DELETE LIGENB, MAKE EVVRSP DEFAULT
-C (GIVEIS FAILS ON CRAY FOR BENCHMC AND BENCHCI)
-C 7 JUL 86 - JAB - SANITIZE FLOATING POINT CONSTANTS
-C 11 OCT 85 - STE - LIGENB,TQL2: USE DROT,DSWAP; TINVTB: SCALE VECTOR
-C BEFORE NORMALIZING; GENERIC FUNCTIONS
-C 24 FEB 84 - STE - INITIALIZE INDEX ARRAY FOR LIGENB IN GLDIAG
-C 1 DEC 83 - STE - CHANGE MACHEP FROM 2**-54 TO 2**-50
-C 28 SEP 82 - MWS - CONVERT TO IBM
-C
-C*MODULE EIGEN *DECK EINVIT
- SUBROUTINE EINVIT(NM,N,D,E,E2,M,W,IND,Z,IERR,RV1,RV2,RV3,RV4,RV6)
-C*
-C* AUTHORS-
-C* THIS IS A MODIFICATION OF TINVIT FROM EISPACK EDITION 3
-C* DATED AUGUST 1983.
-C* TINVIT IS A TRANSLATION OF THE INVERSE ITERATION TECHNIQUE
-C* IN THE ALGOL PROCEDURE TRISTURM BY PETERS AND WILKINSON.
-C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 418-439(1971).
-C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE)
-C*
-C* PURPOSE -
-C* THIS ROUTINE FINDS THOSE EIGENVECTORS OF A TRIDIAGONAL
-C* SYMMETRIC MATRIX CORRESPONDING TO SPECIFIED EIGENVALUES.
-C*
-C* METHOD -
-C* INVERSE ITERATION.
-C*
-C* ON ENTRY -
-C* NM - INTEGER
-C* MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL
-C* ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE
-C* DIMENSION STATEMENT.
-C* N - INTEGER
-C* D - W.P. REAL (N)
-C* CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX.
-C* E - W.P. REAL (N)
-C* CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX
-C* IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY.
-C* E2 - W.P. REAL (N)
-C* CONTAINS THE SQUARES OF CORRESPONDING ELEMENTS OF E,
-C* WITH ZEROS CORRESPONDING TO NEGLIGIBLE ELEMENTS OF E.
-C* E(I) IS CONSIDERED NEGLIGIBLE IF IT IS NOT LARGER THAN
-C* THE PRODUCT OF THE RELATIVE MACHINE PRECISION AND THE
-C* SUM OF THE MAGNITUDES OF D(I) AND D(I-1). E2(1) MUST
-C* CONTAIN 0.0 IF THE EIGENVALUES ARE IN ASCENDING ORDER,
-C* OR 2.0 IF THE EIGENVALUES ARE IN DESCENDING ORDER.
-C* IF TQLRAT, BISECT, TRIDIB, OR IMTQLV
-C* HAS BEEN USED TO FIND THE EIGENVALUES, THEIR
-C* OUTPUT E2 ARRAY IS EXACTLY WHAT IS EXPECTED HERE.
-C* M - INTEGER
-C* THE NUMBER OF SPECIFIED EIGENVECTORS.
-C* W - W.P. REAL (M)
-C* CONTAINS THE M EIGENVALUES IN ASCENDING
-C* OR DESCENDING ORDER.
-C* IND - INTEGER (M)
-C* CONTAINS IN FIRST M POSITIONS THE SUBMATRIX INDICES
-C* ASSOCIATED WITH THE CORRESPONDING EIGENVALUES IN W --
-C* 1 FOR EIGENVALUES BELONGING TO THE FIRST SUBMATRIX
-C* FROM THE TOP, 2 FOR THOSE BELONGING TO THE SECOND
-C* SUBMATRIX, ETC.
-C* IERR - INTEGER (LOGICAL UNIT NUMBER)
-C* LOGICAL UNIT FOR ERROR MESSAGES
-C*
-C* ON EXIT -
-C* ALL INPUT ARRAYS ARE UNALTERED.
-C* Z - W.P. REAL (NM,M)
-C* CONTAINS THE ASSOCIATED SET OF ORTHONORMAL
-C* EIGENVECTORS. ANY VECTOR WHICH WHICH FAILS TO CONVERGE
-C* IS LEFT AS IS (BUT NORMALIZED) WHEN ITERATING STOPPED.
-C* IERR - INTEGER
-C* SET TO
-C* ZERO FOR NORMAL RETURN,
-C* -R IF THE EIGENVECTOR CORRESPONDING TO THE R-TH
-C* EIGENVALUE FAILS TO CONVERGE IN 5 ITERATIONS.
-C* (ONLY LAST FAILURE TO CONVERGE IS REPORTED)
-C*
-C* RV1, RV2, RV3, RV4, AND RV6 ARE TEMPORARY STORAGE ARRAYS.
-C*
-C* RV1 - W.P. REAL (N)
-C* DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION
-C* RV2 - W.P. REAL (N)
-C* SUPER(1)-DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION
-C* RV3 - W.P. REAL (N)
-C* SUPER(2)-DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION
-C* RV4 - W.P. REAL (N)
-C* ELEMENTS DEFINING L IN LU DECOMPOSITION
-C* RV6 - W.P. REAL (N)
-C* APPROXIMATE EIGENVECTOR
-C*
-C* DIFFERENCES FROM EISPACK 3 -
-C* EPS3 IS SCALED BY EPSCAL (ENHANCES CONVERGENCE, BUT
-C* LOWERS ACCURACY)!
-C* ONE MORE ITERATION (MINIMUM 2) IS PERFORMED AFTER CONVERGENCE
-C* (ENHANCES ACCURACY)!
-C* REPLACE LOOP WITH PYTHAG WITH SINGLE CALL TO DNRM2!
-C* IF NOT CONVERGED, USE PERFORMANCE INDEX TO DECIDE ON ERROR
-C* VALUE SETTING, BUT DO NOT STOP!
-C* L.U. FOR ERROR MESSAGES PASSED THROUGH IERR
-C* USE PARAMETER STATEMENTS AND GENERIC INTRINSIC FUNCTIONS
-C* USE LEVEL 1 BLAS
-C* USE IF-THEN-ELSE TO CLARIFY LOGIC
-C* LOOP OVER SUBSPACES MADE INTO DO LOOP.
-C* LOOP OVER INVERSE ITERATIONS MADE INTO DO LOOP
-C* ZERO ONLY REQUIRED PORTIONS OF OUTPUT VECTOR
-C*
-C* NOTE -
-C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO
-C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB.
-C*
-C
- LOGICAL CONVGD,GOPARR,DSKWRK,MASWRK
-C
- INTEGER GROUP,I,IERR,ITS,J,JJ,M,N,NM,P,Q,R,S,SUBMAT,TAG
- INTEGER IND(M)
-C
- DOUBLE PRECISION D(N),E(N),E2(N),W(M),Z(NM,M)
- DOUBLE PRECISION RV1(N),RV2(N),RV3(N),RV4(N),RV6(N)
- DOUBLE PRECISION ANORM,EPS2,EPS3,EPS4,NORM,ORDER,RHO,U,UK,V
- DOUBLE PRECISION X0,X1,XU
- DOUBLE PRECISION EPSCAL,GRPTOL,HUNDRD,ONE,TEN,ZERO
- DOUBLE PRECISION EPSLON, ESTPI1, DASUM, DDOT, DNRM2
-C
- COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
-C
- PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00, GRPTOL = 0.001D+00)
- PARAMETER (EPSCAL = 0.5D+00, HUNDRD = 100.0D+00, TEN = 10.0D+00)
-C
- 001 FORMAT(' EIGENVECTOR ROUTINE EINVIT DID NOT CONVERGE FOR VECTOR'
- * ,I5,'. NORM =',1P,E10.2,' PERFORMANCE INDEX =',E10.2/
- * ' (AN ERROR HALT WILL OCCUR IF THE PI IS GREATER THAN 100)')
-C
-C-----------------------------------------------------------------------
-C
- LUEMSG = IERR
- IERR = 0
- X0 = ZERO
- UK = ZERO
- NORM = ZERO
- EPS2 = ZERO
- EPS3 = ZERO
- EPS4 = ZERO
- GROUP = 0
- TAG = 0
- ORDER = ONE - E2(1)
- Q = 0
- DO 930 SUBMAT = 1, N
- P = Q + 1
-C
-C .......... ESTABLISH AND PROCESS NEXT SUBMATRIX ..........
-C
- DO 120 Q = P, N-1
- IF (E2(Q+1) .EQ. ZERO) GO TO 140
- 120 CONTINUE
- Q = N
-C
-C .......... FIND VECTORS BY INVERSE ITERATION ..........
-C
- 140 CONTINUE
- TAG = TAG + 1
- ANORM = ZERO
- S = 0
-C
- DO 920 R = 1, M
- IF (IND(R) .NE. TAG) GO TO 920
- ITS = 1
- X1 = W(R)
- IF (S .NE. 0) GO TO 510
-C
-C .......... CHECK FOR ISOLATED ROOT ..........
-C
- XU = ONE
- IF (P .EQ. Q) THEN
- RV6(P) = ONE
- CONVGD = .TRUE.
- GO TO 860
-C
- END IF
- NORM = ABS(D(P))
- DO 500 I = P+1, Q
- NORM = MAX( NORM, ABS(D(I)) + ABS(E(I)) )
- 500 CONTINUE
-C
-C .......... EPS2 IS THE CRITERION FOR GROUPING,
-C EPS3 REPLACES ZERO PIVOTS AND EQUAL
-C ROOTS ARE MODIFIED BY EPS3,
-C EPS4 IS TAKEN VERY SMALL TO AVOID OVERFLOW .........
-C
- EPS2 = GRPTOL * NORM
- EPS3 = EPSCAL * EPSLON(NORM)
- UK = Q - P + 1
- EPS4 = UK * EPS3
- UK = EPS4 / SQRT(UK)
- S = P
- GROUP = 0
- GO TO 520
-C
-C .......... LOOK FOR CLOSE OR COINCIDENT ROOTS ..........
-C
- 510 IF (ABS(X1-X0) .GE. EPS2) THEN
-C
-C ROOTS ARE SEPERATE
-C
- GROUP = 0
- ELSE
-C
-C ROOTS ARE CLOSE
-C
- GROUP = GROUP + 1
- IF (ORDER * (X1 - X0) .LE. EPS3) X1 = X0 + ORDER * EPS3
- END IF
-C
-C .......... ELIMINATION WITH INTERCHANGES AND
-C INITIALIZATION OF VECTOR ..........
-C
- 520 CONTINUE
-C
- U = D(P) - X1
- V = E(P+1)
- RV6(P) = UK
- DO 550 I = P+1, Q
- RV6(I) = UK
- IF (ABS(E(I)) .GT. ABS(U)) THEN
-C
-C EXCHANGE ROWS BEFORE ELIMINATION
-C
-C *** WARNING -- A DIVIDE CHECK MAY OCCUR HERE IF
-C E2 ARRAY HAS NOT BEEN SPECIFIED CORRECTLY .......
-C
- XU = U / E(I)
- RV4(I) = XU
- RV1(I-1) = E(I)
- RV2(I-1) = D(I) - X1
- RV3(I-1) = E(I+1)
- U = V - XU * RV2(I-1)
- V = -XU * RV3(I-1)
-C
- ELSE
-C
-C STRAIGHT ELIMINATION
-C
- XU = E(I) / U
- RV4(I) = XU
- RV1(I-1) = U
- RV2(I-1) = V
- RV3(I-1) = ZERO
- U = D(I) - X1 - XU * V
- V = E(I+1)
- END IF
- 550 CONTINUE
-C
- IF (ABS(U) .LE. EPS3) U = EPS3
- RV1(Q) = U
- RV2(Q) = ZERO
- RV3(Q) = ZERO
-C
-C DO INVERSE ITERATIONS
-C
- CONVGD = .FALSE.
- DO 800 ITS = 1, 5
- IF (ITS .EQ. 1) GO TO 600
-C
-C .......... FORWARD SUBSTITUTION ..........
-C
- IF (NORM .EQ. ZERO) THEN
- RV6(S) = EPS4
- S = S + 1
- IF (S .GT. Q) S = P
- ELSE
- XU = EPS4 / NORM
- CALL DSCAL (Q-P+1, XU, RV6(P), 1)
- END IF
-C
-C ... ELIMINATION OPERATIONS ON NEXT VECTOR
-C
- DO 590 I = P+1, Q
- U = RV6(I)
-C
-C IF RV1(I-1) .EQ. E(I), A ROW INTERCHANGE
-C WAS PERFORMED EARLIER IN THE
-C TRIANGULARIZATION PROCESS ..........
-C
- IF (RV1(I-1) .EQ. E(I)) THEN
- U = RV6(I-1)
- RV6(I-1) = RV6(I)
- ELSE
- U = RV6(I)
- END IF
- RV6(I) = U - RV4(I) * RV6(I-1)
- 590 CONTINUE
- 600 CONTINUE
-C
-C .......... BACK SUBSTITUTION
-C
- RV6(Q) = RV6(Q) / RV1(Q)
- V = U
- U = RV6(Q)
- NORM = ABS(U)
- DO 620 I = Q-1, P, -1
- RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I)
- V = U
- U = RV6(I)
- NORM = NORM + ABS(U)
- 620 CONTINUE
- IF (GROUP .EQ. 0) GO TO 700
-C
-C ....... ORTHOGONALIZE WITH RESPECT TO PREVIOUS
-C MEMBERS OF GROUP ..........
-C
- J = R
- DO 680 JJ = 1, GROUP
- 630 J = J - 1
- IF (IND(J) .NE. TAG) GO TO 630
- CALL DAXPY(Q-P+1, -DDOT(Q-P+1,RV6(P),1,Z(P,J),1),
- * Z(P,J),1,RV6(P),1)
- 680 CONTINUE
- NORM = DASUM(Q-P+1, RV6(P), 1)
- 700 CONTINUE
-C
- IF (CONVGD) GO TO 840
- IF (NORM .GE. ONE) CONVGD = .TRUE.
- 800 CONTINUE
-C
-C .......... NORMALIZE SO THAT SUM OF SQUARES IS
-C 1 AND EXPAND TO FULL ORDER ..........
-C
- 840 CONTINUE
-C
- XU = ONE / DNRM2(Q-P+1,RV6(P),1)
-C
- 860 CONTINUE
- DO 870 I = 1, P-1
- Z(I,R) = ZERO
- 870 CONTINUE
- DO 890 I = P,Q
- Z(I,R) = RV6(I) * XU
- 890 CONTINUE
- DO 900 I = Q+1, N
- Z(I,R) = ZERO
- 900 CONTINUE
-C
- IF (.NOT.CONVGD) THEN
- RHO = ESTPI1(Q-P+1,X1,D(P),E(P),Z(P,R),ANORM)
- IF (RHO .GE. TEN .AND. LUEMSG .GT. 0 .AND. MASWRK)
- * WRITE(LUEMSG,001) R,NORM,RHO
-C
-C *** SET ERROR -- NON-CONVERGED EIGENVECTOR ..........
-C
- IF (RHO .GT. HUNDRD) IERR = -R
- END IF
-C
- X0 = X1
- 920 CONTINUE
-C
- IF (Q .EQ. N) GO TO 940
- 930 CONTINUE
- 940 CONTINUE
- RETURN
- END
-C*MODULE EIGEN *DECK ELAUM
- SUBROUTINE ELAU(HINV,L,D,A,E)
-C
- DOUBLE PRECISION A(*)
- DOUBLE PRECISION D(L)
- DOUBLE PRECISION E(L)
- DOUBLE PRECISION F
- DOUBLE PRECISION G
- DOUBLE PRECISION HALF
- DOUBLE PRECISION HH
- DOUBLE PRECISION HINV
- DOUBLE PRECISION ZERO
-C
- PARAMETER (ZERO = 0.0D+00, HALF = 0.5D+00)
-C
- JL = L
- E(1) = A(1) * D(1)
- JK = 2
- DO 210 J = 2, JL
- F = D(J)
- G = ZERO
- JM1 = J - 1
-C
- DO 200 K = 1, JM1
- G = G + A(JK) * D(K)
- E(K) = E(K) + A(JK) * F
- JK = JK + 1
- 200 CONTINUE
-C
- E(J) = G + A(JK) * F
- JK = JK + 1
- 210 CONTINUE
-C
-C .......... FORM P ..........
-C
- F = ZERO
- DO 245 J = 1, L
- E(J) = E(J) * HINV
- F = F + E(J) * D(J)
- 245 CONTINUE
-C
-C .......... FORM Q ..........
-C
- HH = F * HALF * HINV
- DO 250 J = 1, L
- 250 E(J) = E(J) - HH * D(J)
-C
- RETURN
- END
-C*MODULE EIGEN *DECK EPSLON
- DOUBLE PRECISION FUNCTION EPSLON (X)
-C*
-C* AUTHORS -
-C* THIS ROUTINE WAS TAKEN FROM EISPACK EDITION 3 DATED 4/6/83
-C* THIS VERSION IS BY S. T. ELBERT, AMES LABORATORY-USDOE NOV 1986
-C*
-C* PURPOSE -
-C* ESTIMATE UNIT ROUNDOFF IN QUANTITIES OF SIZE X.
-C*
-C* ON ENTRY -
-C* X - WORKING PRECISION REAL
-C* VALUES TO FIND EPSLON FOR
-C*
-C* ON EXIT -
-C* EPSLON - WORKING PRECISION REAL
-C* SMALLEST POSITIVE VALUE SUCH THAT X+EPSLON .NE. ZERO
-C*
-C* QUALIFICATIONS -
-C* THIS ROUTINE SHOULD PERFORM PROPERLY ON ALL SYSTEMS
-C* SATISFYING THE FOLLOWING TWO ASSUMPTIONS,
-C* 1. THE BASE USED IN REPRESENTING FLOATING POINT
-C* NUMBERS IS NOT A POWER OF THREE.
-C* 2. THE QUANTITY A IN STATEMENT 10 IS REPRESENTED TO
-C* THE ACCURACY USED IN FLOATING POINT VARIABLES
-C* THAT ARE STORED IN MEMORY.
-C* THE STATEMENT NUMBER 10 AND THE GO TO 10 ARE INTENDED TO
-C* FORCE OPTIMIZING COMPILERS TO GENERATE CODE SATISFYING
-C* ASSUMPTION 2.
-C* UNDER THESE ASSUMPTIONS, IT SHOULD BE TRUE THAT,
-C* A IS NOT EXACTLY EQUAL TO FOUR-THIRDS,
-C* B HAS A ZERO FOR ITS LAST BIT OR DIGIT,
-C* C IS NOT EXACTLY EQUAL TO ONE,
-C* EPS MEASURES THE SEPARATION OF 1.0 FROM
-C* THE NEXT LARGER FLOATING POINT NUMBER.
-C* THE DEVELOPERS OF EISPACK WOULD APPRECIATE BEING INFORMED
-C* ABOUT ANY SYSTEMS WHERE THESE ASSUMPTIONS DO NOT HOLD.
-C*
-C* DIFFERENCES FROM EISPACK 3 -
-C* USE IS MADE OF PARAMETER STATEMENTS AND INTRINSIC FUNCTIONS
-C* --NO EXECUTEABLE CODE CHANGES--
-C*
-C* NOTE -
-C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO
-C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB.
-C
- DOUBLE PRECISION A,B,C,EPS,X
- DOUBLE PRECISION ZERO, ONE, THREE, FOUR
-C
- PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, THREE=3.0D+00, FOUR=4.0D+00)
-C
-C-----------------------------------------------------------------------
-C
- A = FOUR/THREE
- 10 B = A - ONE
- C = B + B + B
- EPS = ABS(C - ONE)
- IF (EPS .EQ. ZERO) GO TO 10
- EPSLON = EPS*ABS(X)
- RETURN
- END
-C*MODULE EIGEN *DECK EQLRAT
- SUBROUTINE EQLRAT(N,DIAG,E,E2IN,D,IND,IERR,E2)
-C*
-C* AUTHORS -
-C* THIS IS A MODIFICATION OF ROUTINE EQLRAT FROM EISPACK EDITION 3
-C* DATED AUGUST 1983.
-C* TQLRAT IS A TRANSLATION OF THE ALGOL PROCEDURE TQLRAT,
-C* ALGORITHM 464, COMM. ACM 16, 689(1973) BY REINSCH.
-C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE)
-C*
-C* PURPOSE -
-C* THIS ROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC
-C* TRIDIAGONAL MATRIX
-C*
-C* METHOD -
-C* RATIONAL QL
-C*
-C* ON ENTRY -
-C* N - INTEGER
-C* THE ORDER OF THE MATRIX.
-C* D - W.P. REAL (N)
-C* CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX.
-C* E2 - W.P. REAL (N)
-C* CONTAINS THE SQUARES OF THE SUBDIAGONAL ELEMENTS OF
-C* THE INPUT MATRIX IN ITS LAST N-1 POSITIONS.
-C* E2(1) IS ARBITRARY.
-C*
-C* ON EXIT -
-C* D - W.P. REAL (N)
-C* CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN
-C* ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND
-C* ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE
-C* THE SMALLEST EIGENVALUES.
-C* E2 - W.P. REAL (N)
-C* DESTROYED.
-C* IERR - INTEGER
-C* SET TO
-C* ZERO FOR NORMAL RETURN,
-C* J IF THE J-TH EIGENVALUE HAS NOT BEEN
-C* DETERMINED AFTER 30 ITERATIONS.
-C*
-C* DIFFERENCES FROM EISPACK 3 -
-C* G=G+B INSTEAD OF IF(G.EQ.0) G=B ; B=B/4
-C* F77 BACKWARD LOOPS INSTEAD OF F66 CONSTRUCT
-C* GENERIC INTRINSIC FUNCTIONS
-C* ARRARY IND ADDED FOR USE BY EINVIT
-C*
-C* NOTE -
-C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO
-C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB.
-C
- INTEGER I,J,L,M,N,II,L1,IERR
- INTEGER IND(N)
-C
- DOUBLE PRECISION D(N),E(N),E2(N),DIAG(N),E2IN(N)
- DOUBLE PRECISION B,C,F,G,H,P,R,S,T,EPSLON
- DOUBLE PRECISION SCALE,ZERO,ONE
-C
- PARAMETER (ZERO = 0.0D+00, SCALE= 1.0D+00/64.0D+00, ONE = 1.0D+00)
-C
-C-----------------------------------------------------------------------
- IERR = 0
- D(1)=DIAG(1)
- IND(1) = 1
- K = 0
- ITAG = 0
- IF (N .EQ. 1) GO TO 1001
-C
- DO 100 I = 2, N
- D(I)=DIAG(I)
- 100 E2(I-1) = E2IN(I)
-C
- F = ZERO
- T = ZERO
- B = EPSLON(ONE)
- C = B *B
- B = B * SCALE
- E2(N) = ZERO
-C
- DO 290 L = 1, N
- H = ABS(D(L)) + ABS(E(L))
- IF (T .GE. H) GO TO 105
- T = H
- B = EPSLON(T)
- C = B * B
- B = B * SCALE
- 105 CONTINUE
-C .......... LOOK FOR SMALL SQUARED SUB-DIAGONAL ELEMENT ..........
- M = L - 1
- 110 M = M + 1
- IF (E2(M) .GT. C) GO TO 110
-C .......... E2(N) IS ALWAYS ZERO, SO THERE IS AN EXIT
-C FROM THE LOOP ..........
-C
- IF (M .LE. K) GO TO 125
- IF (M .NE. N) E2IN(M+1) = ZERO
- K = M
- ITAG = ITAG + 1
- 125 CONTINUE
- IF (M .EQ. L) GO TO 210
-C
-C ITERATE
-C
- DO 205 J = 1, 30
-C .......... FORM SHIFT ..........
- L1 = L + 1
- S = SQRT(E2(L))
- G = D(L)
- P = (D(L1) - G) / (2.0D+00 * S)
- R = SQRT(P*P+1.0D+00)
- D(L) = S / (P + SIGN(R,P))
- H = G - D(L)
-C
- DO 140 I = L1, N
- 140 D(I) = D(I) - H
-C
- F = F + H
-C .......... RATIONAL QL TRANSFORMATION ..........
- G = D(M) + B
- H = G
- S = ZERO
- DO 200 I = M-1,L,-1
- P = G * H
- R = P + E2(I)
- E2(I+1) = S * R
- S = E2(I) / R
- D(I+1) = H + S * (H + D(I))
- G = D(I) - E2(I) / G + B
- H = G * P / R
- 200 CONTINUE
-C
- E2(L) = S * G
- D(L) = H
-C .......... GUARD AGAINST UNDERFLOW IN CONVERGENCE TEST
- IF (H .EQ. ZERO) GO TO 210
- IF (ABS(E2(L)) .LE. ABS(C/H)) GO TO 210
- E2(L) = H * E2(L)
- IF (E2(L) .EQ. ZERO) GO TO 210
- 205 CONTINUE
-C .......... SET ERROR -- NO CONVERGENCE TO AN
-C EIGENVALUE AFTER 30 ITERATIONS ..........
- IERR = L
- GO TO 1001
-C
-C CONVERGED
-C
- 210 P = D(L) + F
-C .......... ORDER EIGENVALUES ..........
- I = 1
- IF (L .EQ. 1) GO TO 250
- IF (P .LT. D(1)) GO TO 230
- I = L
-C .......... LOOP TO FIND ORDERED POSITION
- 220 I = I - 1
- IF (P .LT. D(I)) GO TO 220
-C
- I = I + 1
- IF (I .EQ. L) GO TO 250
- 230 CONTINUE
- DO 240 II = L, I+1, -1
- D(II) = D(II-1)
- IND(II) = IND(II-1)
- 240 CONTINUE
-C
- 250 CONTINUE
- D(I) = P
- IND(I) = ITAG
- 290 CONTINUE
-C
- 1001 RETURN
- END
-C*MODULE EIGEN *DECK ESTPI1
- DOUBLE PRECISION FUNCTION ESTPI1 (N,EVAL,D,E,X,ANORM)
-C*
-C* AUTHOR -
-C* STEPHEN T. ELBERT (AMES LABORATORY-USDOE) DATE: 5 DEC 1986
-C*
-C* PURPOSE -
-C* EVALUATE SYMMETRIC TRIDIAGONAL MATRIX PERFORMANCE INDEX
-C* * * * * *
-C* FOR 1 EIGENVECTOR
-C* *
-C*
-C* METHOD -
-C* THIS ROUTINE FORMS THE 1-NORM OF THE RESIDUAL MATRIX A*X-X*EVAL
-C* WHERE A IS A SYMMETRIC TRIDIAGONAL MATRIX STORED
-C* IN THE DIAGONAL (D) AND SUB-DIAGONAL (E) VECTORS, EVAL IS THE
-C* EIGENVALUE OF AN EIGENVECTOR OF A, NAMELY X.
-C* THIS NORM IS SCALED BY MACHINE ACCURACY FOR THE PROBLEM SIZE.
-C* ALL NORMS APPEARING IN THE COMMENTS BELOW ARE 1-NORMS.
-C*
-C* ON ENTRY -
-C* N - INTEGER
-C* THE ORDER OF THE MATRIX A.
-C* EVAL - W.P. REAL
-C* THE EIGENVALUE CORRESPONDING TO VECTOR X.
-C* D - W.P. REAL (N)
-C* THE DIAGONAL VECTOR OF A.
-C* E - W.P. REAL (N)
-C* THE SUB-DIAGONAL VECTOR OF A.
-C* X - W.P. REAL (N)
-C* AN EIGENVECTOR OF A.
-C* ANORM - W.P. REAL
-C* THE NORM OF A IF IT HAS BEEN PREVIOUSLY COMPUTED.
-C*
-C* ON EXIT -
-C* ANORM - W.P. REAL
-C* THE NORM OF A, COMPUTED IF INITIALLY ZERO.
-C* ESTPI1 - W.P. REAL
-C* !!A*X-X*EVAL!! / (EPSLON(10*N)*!!A!!*!!X!!);
-C* WHERE EPSLON(X) IS THE SMALLEST NUMBER SUCH THAT
-C* X + EPSLON(X) .NE. X
-C*
-C* ESTPI1 .LT. 1 == SATISFACTORY PERFORMANCE
-C* .GE. 1 AND .LE. 100 == MARGINAL PERFORMANCE
-C* .GT. 100 == POOR PERFORMANCE
-C* (SEE LECT. NOTES IN COMP. SCI. VOL.6 PP 124-125)
-C
- DOUBLE PRECISION ANORM,EVAL,RNORM,SIZE,XNORM
- DOUBLE PRECISION D(N), E(N), X(N)
- DOUBLE PRECISION EPSLON, ONE, ZERO
-C
- PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00)
-C
-C-----------------------------------------------------------------------
-C
- ESTPI1 = ZERO
- IF( N .LE. 1 ) RETURN
- SIZE = 10 * N
- IF (ANORM .EQ. ZERO) THEN
-C
-C COMPUTE NORM OF A
-C
- ANORM = MAX( ABS(D(1)) + ABS(E(2))
- * ,ABS(D(N)) + ABS(E(N)))
- DO 110 I = 2, N-1
- ANORM = MAX( ANORM, ABS(E(I))+ABS(D(I))+ABS(E(I+1)))
- 110 CONTINUE
- IF(ANORM .EQ. ZERO) ANORM = ONE
- END IF
-C
-C COMPUTE NORMS OF RESIDUAL AND EIGENVECTOR
-C
- XNORM = ABS(X(1)) + ABS(X(N))
- RNORM = ABS( (D(1)-EVAL)*X(1) + E(2)*X(2))
- * +ABS( (D(N)-EVAL)*X(N) + E(N)*X(N-1))
- DO 120 I = 2, N-1
- XNORM = XNORM + ABS(X(I))
- RNORM = RNORM + ABS(E(I)*X(I-1) + (D(I)-EVAL)*X(I)
- * + E(I+1)*X(I+1))
- 120 CONTINUE
-C
- ESTPI1 = RNORM / (EPSLON(SIZE)*ANORM*XNORM)
- RETURN
- END
-C*MODULE EIGEN *DECK ETRBK3
- SUBROUTINE ETRBK3(NM,N,NV,A,M,Z)
-C*
-C* AUTHORS-
-C* THIS IS A MODIFICATION OF ROUTINE TRBAK3 FROM EISPACK EDITION 3
-C* DATED AUGUST 1983.
-C* EISPACK TRBAK3 IS A TRANSLATION OF THE ALGOL PROCEDURE TRBAK3,
-C* NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON.
-C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
-C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE)
-C*
-C* PURPOSE -
-C* THIS ROUTINE FORMS THE EIGENVECTORS OF A REAL SYMMETRIC
-C* MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING
-C* SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY ETRED3.
-C*
-C* METHOD -
-C* THE CALCULATION IS CARRIED OUT BY FORMING THE MATRIX PRODUCT
-C* Q*Z
-C* WHERE Q IS A PRODUCT OF THE ORTHOGONAL SYMMETRIC MATRICES
-C* Q = PROD(I)[1 - U(I)*.TRANSPOSE.U(I)*H(I)]
-C* U IS THE AUGMENTED SUB-DIAGONAL ROWS OF A AND
-C* Z IS THE SET OF EIGENVECTORS OF THE TRIDIAGONAL
-C* MATRIX F WHICH WAS FORMED FROM THE ORIGINAL SYMMETRIC
-C* MATRIX C BY THE SIMILARITY TRANSFORMATION
-C* F = Q(TRANSPOSE) C Q
-C* NOTE THAT ETRBK3 PRESERVES VECTOR EUCLIDEAN NORMS.
-C*
-C*
-C* COMPLEXITY -
-C* M*N**2
-C*
-C* ON ENTRY-
-C* NM - INTEGER
-C* MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL
-C* ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE
-C* DIMENSION STATEMENT.
-C* N - INTEGER
-C* THE ORDER OF THE MATRIX A.
-C* NV - INTEGER
-C* MUST BE SET TO THE DIMENSION OF THE ARRAY A AS
-C* DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT.
-C* A - W.P. REAL (NV)
-C* CONTAINS INFORMATION ABOUT THE ORTHOGONAL
-C* TRANSFORMATIONS USED IN THE REDUCTION BY ETRED3 IN
-C* ITS FIRST NV = N*(N+1)/2 POSITIONS.
-C* M - INTEGER
-C* THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED.
-C* Z - W.P REAL (NM,M)
-C* CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED
-C* IN ITS FIRST M COLUMNS.
-C*
-C* ON EXIT-
-C* Z - W.P. REAL (NM,M)
-C* CONTAINS THE TRANSFORMED EIGENVECTORS
-C* IN ITS FIRST M COLUMNS.
-C*
-C* DIFFERENCES WITH EISPACK 3 -
-C* THE TWO INNER LOOPS ARE REPLACED BY DDOT AND DAXPY.
-C* MULTIPLICATION USED INSTEAD OF DIVISION TO FIND S.
-C* OUTER LOOP RANGE CHANGED FROM 2,N TO 3,N.
-C* ADDRESS POINTERS FOR A SIMPLIFIED.
-C*
-C* NOTE -
-C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO
-C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB.
-C
- INTEGER I,II,IM1,IZ,J,M,N,NM,NV
-C
- DOUBLE PRECISION A(NV),Z(NM,M)
- DOUBLE PRECISION H,S,DDOT,ZERO
-C
- PARAMETER (ZERO = 0.0D+00)
-C
-C-----------------------------------------------------------------------
-C
- IF (M .EQ. 0) RETURN
- IF (N .LE. 2) RETURN
-C
- II=3
- DO 140 I = 3, N
- IZ=II+1
- II=II+I
- H = A(II)
- IF (H .EQ. ZERO) GO TO 140
- IM1 = I - 1
- DO 130 J = 1, M
- S = -( DDOT(IM1,A(IZ),1,Z(1,J),1) * H) * H
- CALL DAXPY(IM1,S,A(IZ),1,Z(1,J),1)
- 130 CONTINUE
- 140 CONTINUE
- RETURN
- END
-C*MODULE EIGEN *DECK ETRED3
- SUBROUTINE ETRED3(N,NV,A,D,E,E2)
-C*
-C* AUTHORS -
-C* THIS IS A MODIFICATION OF ROUTINE TRED3 FROM EISPACK EDITION 3
-C* DATED AUGUST 1983.
-C* EISPACK TRED3 IS A TRANSLATION OF THE ALGOL PROCEDURE TRED3,
-C* NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON.
-C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
-C* THIS VERSION IS BY S. T. ELBERT, AMES LABORATORY-USDOE JUN 1986
-C*
-C* PURPOSE -
-C* THIS ROUTINE REDUCES A REAL SYMMETRIC (PACKED) MATRIX, STORED
-C* AS A ONE-DIMENSIONAL ARRAY, TO A SYMMETRIC TRIDIAGONAL MATRIX
-C* USING ORTHOGONAL SIMILARITY TRANSFORMATIONS, PRESERVING THE
-C* INFORMATION ABOUT THE TRANSFORMATIONS IN A.
-C*
-C* METHOD -
-C* THE TRIDIAGONAL REDUCTION IS PERFORMED IN THE FOLLOWING WAY.
-C* STARTING WITH J=N, THE ELEMENTS IN THE J-TH ROW TO THE
-C* LEFT OF THE DIAGONAL ARE FIRST SCALED, TO AVOID POSSIBLE
-C* UNDERFLOW IN THE TRANSFORMATION THAT MIGHT RESULT IN SEVERE
-C* DEPARTURE FROM ORTHOGONALITY. THE SUM OF SQUARES SIGMA OF
-C* THESE SCALED ELEMENTS IS NEXT FORMED. THEN, A VECTOR U AND
-C* A SCALAR
-C* H = U(TRANSPOSE) * U / 2
-C* DEFINE A REFLECTION OPERATOR
-C* P = I - U * U(TRANSPOSE) / H
-C* WHICH IS ORTHOGONAL AND SYMMETRIC AND FOR WHICH THE
-C* SIMILIARITY TRANSFORMATION PAP ELIMINATES THE ELEMENTS IN
-C* THE J-TH ROW OF A TO THE LEFT OF THE SUBDIAGONAL AND THE
-C* SYMMETRICAL ELEMENTS IN THE J-TH COLUMN.
-C*
-C* THE NON-ZERO COMPONENTS OF U ARE THE ELEMENTS OF THE J-TH
-C* ROW TO THE LEFT OF THE DIAGONAL WITH THE LAST OF THEM
-C* AUGMENTED BY THE SQUARE ROOT OF SIGMA PREFIXED BY THE SIGN
-C* OF THE SUBDIAGONAL ELEMENT. BY STORING THE TRANSFORMED SUB-
-C* DIAGONAL ELEMENT IN E(J) AND NOT OVERWRITING THE ROW
-C* ELEMENTS ELIMINATED IN THE TRANSFORMATION, FULL INFORMATION
-C* ABOUT P IS SAVE FOR LATER USE IN ETRBK3.
-C*
-C* THE TRANSFORMATION SETS E2(J) EQUAL TO SIGMA AND E(J)
-C* EQUAL TO THE SQUARE ROOT OF SIGMA PREFIXED BY THE SIGN
-C* OF THE REPLACED SUBDIAGONAL ELEMENT.
-C*
-C* THE ABOVE STEPS ARE REPEATED ON FURTHER ROWS OF THE
-C* TRANSFORMED A IN REVERSE ORDER UNTIL A IS REDUCED TO TRI-
-C* DIAGONAL FORM, THAT IS, REPEATED FOR J = N-1,N-2,...,3.
-C*
-C* COMPLEXITY -
-C* 2/3 N**3
-C*
-C* ON ENTRY-
-C* N - INTEGER
-C* THE ORDER OF THE MATRIX.
-C* NV - INTEGER
-C* MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A
-C* AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT
-C* A - W.P. REAL (NV)
-C* CONTAINS THE LOWER TRIANGLE OF THE REAL SYMMETRIC
-C* INPUT MATRIX, STORED ROW-WISE AS A ONE-DIMENSIONAL
-C* ARRAY, IN ITS FIRST N*(N+1)/2 POSITIONS.
-C*
-C* ON EXIT-
-C* A - W.P. REAL (NV)
-C* CONTAINS INFORMATION ABOUT THE ORTHOGONAL
-C* TRANSFORMATIONS USED IN THE REDUCTION.
-C* D - W.P. REAL (N)
-C* CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL
-C* MATRIX.
-C* E - W.P. REAL (N)
-C* CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL
-C* MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO
-C* E2 - W.P. REAL (N)
-C* CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF
-C* E. MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED.
-C*
-C* DIFFERENCES FROM EISPACK 3 -
-C* OUTER LOOP CHANGED FROM II=1,N TO I=N,3,-1
-C* PARAMETER STATEMENT AND GENERIC INTRINSIC FUNCTIONS USED
-C* SCALE.NE.0 TEST NOW SPOTS TRI-DIAGONAL FORM
-C* VALUES LESS THAN EPSLON CLEARED TO ZERO
-C* USE BLAS(1)
-C* U NOT COPIED TO D, LEFT IN A
-C* E2 COMPUTED FROM E
-C* INNER LOOPS SPLIT INTO ROUTINES ELAU AND FREDA
-C* INVERSE OF H STORED INSTEAD OF H
-C*
-C* NOTE -
-C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO
-C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB.
-C
- INTEGER I,IIA,IZ0,L,N,NV
-C
- DOUBLE PRECISION A(NV),D(N),E(N),E2(N)
- DOUBLE PRECISION AIIMAX,F,G,H,HROOT,SCALE,SCALEI
- DOUBLE PRECISION DASUM, DNRM2
- DOUBLE PRECISION ONE, ZERO
-C
- PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00)
-C
-C-----------------------------------------------------------------------
-C
- IF (N .LE. 2) GO TO 310
- IZ0 = (N*N+N)/2
- AIIMAX = ABS(A(IZ0))
- DO 300 I = N, 3, -1
- L = I - 1
- IIA = IZ0
- IZ0 = IZ0 - I
- AIIMAX = MAX(AIIMAX, ABS(A(IIA)))
- SCALE = DASUM (L, A(IZ0+1), 1)
- IF(SCALE .EQ. ABS(A(IIA-1)) .OR. AIIMAX+SCALE .EQ. AIIMAX) THEN
-C
-C THIS ROW IS ALREADY IN TRI-DIAGONAL FORM
-C
- D(I) = A(IIA)
- IF (AIIMAX+D(I) .EQ. AIIMAX) D(I) = ZERO
- E(I) = A(IIA-1)
- IF (AIIMAX+E(I) .EQ. AIIMAX) E(I) = ZERO
- E2(I) = E(I)*E(I)
- A(IIA) = ZERO
- GO TO 300
-C
- END IF
-C
- SCALEI = ONE / SCALE
- CALL DSCAL(L,SCALEI,A(IZ0+1),1)
- HROOT = DNRM2(L,A(IZ0+1),1)
-C
- F = A(IZ0+L)
- G = -SIGN(HROOT,F)
- E(I) = SCALE * G
- E2(I) = E(I)*E(I)
- H = HROOT*HROOT - F * G
- A(IZ0+L) = F - G
- D(I) = A(IIA)
- A(IIA) = ONE / SQRT(H)
-C .......... FORM P THEN Q IN E(1:L) ..........
- CALL ELAU(ONE/H,L,A(IZ0+1),A,E)
-C .......... FORM REDUCED A ..........
- CALL FREDA(L,A(IZ0+1),A,E)
-C
- 300 CONTINUE
- 310 CONTINUE
- E(1) = ZERO
- E2(1)= ZERO
- D(1) = A(1)
- IF(N.EQ.1) RETURN
-C
- E(2) = A(2)
- E2(2)= A(2)*A(2)
- D(2) = A(3)
- RETURN
- END
-C*MODULE EIGEN *DECK EVVRSP
- SUBROUTINE EVVRSP(MSGFL,N,NVECT,LENA,NV,A,B,IND,ROOT,
- * VECT,IORDER,IERR)
-C*
-C* AUTHOR: S. T. ELBERT, AMES LABORATORY-USDOE, JUNE 1985
-C*
-C* PURPOSE -
-C* FINDS (ALL) EIGENVALUES AND (SOME OR ALL) EIGENVECTORS
-C* * * *
-C* OF A REAL SYMMETRIC PACKED MATRIX.
-C* * * *
-C*
-C* METHOD -
-C* THE METHOD AS PRESENTED IN THIS ROUTINE CONSISTS OF FOUR STEPS:
-C* FIRST, THE INPUT MATRIX IS REDUCED TO TRIDIAGONAL FORM BY THE
-C* HOUSEHOLDER TECHNIQUE (ORTHOGONAL SIMILARITY TRANSFORMATIONS).
-C* SECOND, THE ROOTS ARE LOCATED USING THE RATIONAL QL METHOD.
-C* THIRD, THE VECTORS OF THE TRIDIAGONAL FORM ARE EVALUATED BY THE
-C* INVERSE ITERATION TECHNIQUE. VECTORS FOR DEGENERATE OR NEAR-
-C* DEGENERATE ROOTS ARE FORCED TO BE ORTHOGONAL.
-C* FOURTH, THE TRIDIAGONAL VECTORS ARE ROTATED TO VECTORS OF THE
-C* ORIGINAL ARRAY.
-C*
-C* THESE ROUTINES ARE MODIFICATIONS OF THE EISPACK 3
-C* ROUTINES TRED3, TQLRAT, TINVIT AND TRBAK3
-C*
-C* FOR FURTHER DETAILS, SEE EISPACK USERS GUIDE, B. T. SMITH
-C* ET AL, SPRINGER-VERLAG, LECTURE NOTES IN COMPUTER SCIENCE,
-C* VOL. 6, 2-ND EDITION, 1976. ANOTHER GOOD REFERENCE IS
-C* THE SYMMETRIC EIGENVALUE PROBLEM BY B. N. PARLETT
-C* PUBLISHED BY PRENTICE-HALL, INC., ENGLEWOOD CLIFFS, N.J. (1980)
-C*
-C* ON ENTRY -
-C* MSGFL - INTEGER (LOGICAL UNIT NO.)
-C* FILE WHERE ERROR MESSAGES WILL BE PRINTED.
-C* IF MSGFL IS 0, ERROR MESSAGES WILL BE PRINTED ON LU 6.
-C* IF MSGFL IS NEGATIVE, NO ERROR MESSAGES PRINTED.
-C* N - INTEGER
-C* ORDER OF MATRIX A.
-C* NVECT - INTEGER
-C* NUMBER OF VECTORS DESIRED. 0 .LE. NVECT .LE. N.
-C* LENA - INTEGER
-C* DIMENSION OF A IN CALLING ROUTINE. MUST NOT BE LESS
-C* THAN (N*N+N)/2.
-C* NV - INTEGER
-C* ROW DIMENSION OF VECT IN CALLING ROUTINE. N .LE. NV.
-C* A - WORKING PRECISION REAL (LENA)
-C* INPUT MATRIX, ROWS OF THE LOWER TRIANGLE PACKED INTO
-C* LINEAR ARRAY OF DIMENSION N*(N+1)/2. THE PACKED ORDER
-C* IS A(1,1), A(2,1), A(2,2), A(3,1), A(3,2), ...
-C* B - WORKING PRECISION REAL (N,8)
-C* SCRATCH ARRAY, 8*N ELEMENTS
-C* IND - INTEGER (N)
-C* SCRATCH ARRAY OF LENGTH N.
-C* IORDER - INTEGER
-C* ROOT ORDERING FLAG.
-C* = 0, ROOTS WILL BE PUT IN ASCENDING ORDER.
-C* = 2, ROOTS WILL BE PUT IN DESCENDING ORDER.
-C*
-C* ON EXIT -
-C* A - DESTORYED. NOW HOLDS REFLECTION OPERATORS.
-C* ROOT - WORKING PRECISION REAL (N)
-C* ALL EIGENVALUES IN ASCENDING OR DESCENDING ORDER.
-C* IF IORDER = 0, ROOT(1) .LE. ... .LE. ROOT(N)
-C* IF IORDER = 2, ROOT(1) .GE. ... .GE. ROOT(N)
-C* VECT - WORKING PRECISION REAL (NV,NVECT)
-C* EIGENVECTORS FOR ROOT(1), ..., ROOT(NVECT).
-C* IERR - INTEGER
-C* = 0 IF NO ERROR DETECTED,
-C* = K IF ITERATION FOR K-TH EIGENVALUE FAILED,
-C* = -K IF ITERATION FOR K-TH EIGENVECTOR FAILED.
-C* (FAILURES SHOULD BE VERY RARE. CONTACT C. MOLER.)
-C*
-C
- LOGICAL GOPARR,DSKWRK,MASWRK
-C
- DOUBLE PRECISION A(LENA)
- DOUBLE PRECISION B(N,8)
- DOUBLE PRECISION ROOT(N)
- DOUBLE PRECISION T
- DOUBLE PRECISION VECT(NV,*)
-C
- INTEGER IND(N)
-C
- COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
-C
- 900 FORMAT(26H0*** EVVRSP PARAMETERS ***/
- + 14H *** N = ,I8,4H ***/
- + 14H *** NVECT = ,I8,4H ***/
- + 14H *** LENA = ,I8,4H ***/
- + 14H *** NV = ,I8,4H ***/
- + 14H *** IORDER = ,I8,4H ***/
- + 14H *** IERR = ,I8,4H ***)
- 901 FORMAT(37H VALUE OF LENA IS LESS THAN (N*N+N)/2)
- 902 FORMAT(39H EQLRAT HAS FAILED TO CONVERGE FOR ROOT,I5)
- 903 FORMAT(18H NV IS LESS THAN N)
- 904 FORMAT(41H EINVIT HAS FAILED TO CONVERGE FOR VECTOR,I5)
- 905 FORMAT(51H VALUE OF IORDER MUST BE 0 (SMALLEST ROOT FIRST) OR
- * ,23H 2 (LARGEST ROOT FIRST))
- 906 FORMAT(' VALUE OF N IS LESS THAN OR EQUAL ZERO')
-C
-C-----------------------------------------------------------------------
-C
- LMSGFL=MSGFL
- IF (MSGFL .EQ. 0) LMSGFL=6
- IERR = N - 1
- IF (N .LE. 0) GO TO 800
- IERR = N + 1
- IF ( (N*N+N)/2 .GT. LENA) GO TO 810
-C
-C REDUCE REAL SYMMETRIC MATRIX A TO TRIDIAGONAL FORM
-C
- CALL ETRED3(N,LENA,A,B(1,1),B(1,2),B(1,3))
-C
-C FIND ALL EIGENVALUES OF TRIDIAGONAL MATRIX
-C
- CALL EQLRAT(N,B(1,1),B(1,2),B(1,3),ROOT,IND,IERR,B(1,4))
- IF (IERR .NE. 0) GO TO 820
-C
-C CHECK THE DESIRED ORDER OF THE EIGENVALUES
-C
- B(1,3) = IORDER
- IF (IORDER .EQ. 0) GO TO 300
- IF (IORDER .NE. 2) GO TO 850
-C
-C ORDER ROOTS IN DESCENDING ORDER (LARGEST FIRST)...
-C TURN ROOT AND IND ARRAYS END FOR END
-C
- DO 210 I = 1, N/2
- J = N+1-I
- T = ROOT(I)
- ROOT(I) = ROOT(J)
- ROOT(J) = T
- L = IND(I)
- IND(I) = IND(J)
- IND(J) = L
- 210 CONTINUE
-C
-C FIND I AND J MARKING THE START AND END OF A SEQUENCE
-C OF DEGENERATE ROOTS
-C
- I=0
- 220 CONTINUE
- I = I+1
- IF (I .GT. N) GO TO 300
- DO 230 J=I,N
- IF (ROOT(J) .NE. ROOT(I)) GO TO 240
- 230 CONTINUE
- J = N+1
- 240 CONTINUE
- J = J-1
- IF (J .EQ. I) GO TO 220
-C
-C TURN AROUND IND BETWEEN I AND J
-C
- JSV = J
- KLIM = (J-I+1)/2
- DO 250 K=1,KLIM
- L = IND(J)
- IND(J) = IND(I)
- IND(I) = L
- I = I+1
- J = J-1
- 250 CONTINUE
- I = JSV
- GO TO 220
-C
- 300 CONTINUE
-C
- IF (NVECT .LE. 0) RETURN
- IF (NV .LT. N) GO TO 830
-C
-C FIND EIGENVECTORS OF TRI-DIAGONAL MATRIX VIA INVERSE ITERATION
-C
- IERR = LMSGFL
- CALL EINVIT(NV,N,B(1,1),B(1,2),B(1,3),NVECT,ROOT,IND,
- + VECT,IERR,B(1,4),B(1,5),B(1,6),B(1,7),B(1,8))
- IF (IERR .NE. 0) GO TO 840
-C
-C FIND EIGENVECTORS OF SYMMETRIC MATRIX VIA BACK TRANSFORMATION
-C
- 400 CONTINUE
- CALL ETRBK3(NV,N,LENA,A,NVECT,VECT)
- RETURN
-C
-C ERROR MESSAGE SECTION
-C
- 800 IF (LMSGFL .LT. 0) RETURN
- IF (MASWRK) WRITE(LMSGFL,906)
- GO TO 890
-C
- 810 IF (LMSGFL .LT. 0) RETURN
- IF (MASWRK) WRITE(LMSGFL,901)
- GO TO 890
-C
- 820 IF (LMSGFL .LT. 0) RETURN
- IF (MASWRK) WRITE(LMSGFL,902) IERR
- GO TO 890
-C
- 830 IF (LMSGFL .LT. 0) RETURN
- IF (MASWRK) WRITE(LMSGFL,903)
- GO TO 890
-C
- 840 CONTINUE
- IF ((LMSGFL .GT. 0).AND.MASWRK) WRITE(LMSGFL,904) -IERR
- GO TO 400
-C
- 850 IERR=-1
- IF (LMSGFL .LT. 0) RETURN
- IF (MASWRK) WRITE(LMSGFL,905)
- GO TO 890
-C
- 890 CONTINUE
- IF (MASWRK) WRITE(LMSGFL,900) N,NVECT,LENA,NV,IORDER,IERR
- RETURN
- END
-C*MODULE EIGEN *DECK FREDA
- SUBROUTINE FREDA(L,D,A,E)
-C
- DOUBLE PRECISION A(*)
- DOUBLE PRECISION D(L)
- DOUBLE PRECISION E(L)
- DOUBLE PRECISION F
- DOUBLE PRECISION G
-C
- JK = 1
-C
-C .......... FORM REDUCED A ..........
-C
- DO 280 J = 1, L
- F = D(J)
- G = E(J)
-C
- DO 260 K = 1, J
- A(JK) = A(JK) - F * E(K) - G * D(K)
- JK = JK + 1
- 260 CONTINUE
-C
- 280 CONTINUE
- RETURN
- END
-C*MODULE EIGEN *DECK GIVEIS
- SUBROUTINE GIVEIS(N,NVECT,NV,A,B,INDB,ROOT,VECT,IERR)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION A(*),B(N,8),INDB(N),ROOT(N),VECT(NV,NVECT)
-C
-C EISPACK-BASED SUBSTITUTE FOR QCPE ROUTINE GIVENS.
-C FINDS ALL EIGENVALUES AND SOME EIGENVECTORS OF A REAL SYMMETRIC
-C MATRIX. AUTHOR.. C. MOLER AND D. SPANGLER, N.R.C.C., 4/1/79.
-C
-C INPUT..
-C N = ORDER OF MATRIX .
-C NVECT = NUMBER OF VECTORS DESIRED. 0 .LE. NVECT .LE. N .
-C NV = LEADING DIMENSION OF VECT .
-C A = INPUT MATRIX, COLUMNS OF THE UPPER TRIANGLE PACKED INTO
-C LINEAR ARRAY OF DIMENSION N*(N+1)/2 .
-C B = SCRATCH ARRAY, 8*N ELEMENTS (NOTE THIS IS MORE THAN
-C PREVIOUS VERSIONS OF GIVENS.)
-C IND = INDEX ARRAY OF N ELEMENTS
-C
-C OUTPUT..
-C A DESTROYED .
-C ROOT = ALL EIGENVALUES, ROOT(1) .LE. ... .LE. ROOT(N) .
-C (FOR OTHER ORDERINGS, SEE BELOW.)
-C VECT = EIGENVECTORS FOR ROOT(1),..., ROOT(NVECT) .
-C IERR = 0 IF NO ERROR DETECTED,
-C = K IF ITERATION FOR K-TH EIGENVALUE FAILED,
-C = -K IF ITERATION FOR K-TH EIGENVECTOR FAILED.
-C (FAILURES SHOULD BE VERY RARE. CONTACT MOLER.)
-C
-C CALLS MODIFIED EISPACK ROUTINES TRED3B, IMTQLV, TINVTB, AND
-C TRBK3B. THE ROUTINES TRED3B, TINVTB, AND TRBK3B.
-C THE ORIGINAL EISPACK ROUTINES TRED3, TINVIT, AND TRBAK3
-C WERE MODIFIED BY THE INTRODUCTION OF TWO ROUTINES FROM THE
-C BLAS LIBRARY - DDOT AND DAXPY.
-C
-C IF TINVIT FAILS TO CONVERGE, TQL2 IS CALLED
-C
-C SEE EISPACK USERS GUIDE, B. T. SMITH ET AL, SPRINGER-VERLAG
-C LECTURE NOTES IN COMPUTER SCIENCE, VOL. 6, 2-ND EDITION, 1976 .
-C NOTE THAT IMTQLV AND TINVTB HAVE INTERNAL MACHINE
-C DEPENDENT CONSTANTS.
-C
- DATA ONE, ZERO /1.0D+00, 0.0D+00/
- CALL TRED3B(N,(N*N+N)/2,A,B(1,1),B(1,2),B(1,3))
- CALL IMTQLV(N,B(1,1),B(1,2),B(1,3),ROOT,INDB,IERR,B(1,4))
- IF (IERR .NE. 0) RETURN
-C
-C TO REORDER ROOTS...
-C K = N/2
-C B(1,3) = 2.0D+00
-C DO 50 I = 1, K
-C J = N+1-I
-C T = ROOT(I)
-C ROOT(I) = ROOT(J)
-C ROOT(J) = T
-C 50 CONTINUE
-C
- IF (NVECT .LE. 0) RETURN
- CALL TINVTB(NV,N,B(1,1),B(1,2),B(1,3),NVECT,ROOT,INDB,VECT,IERR,
- + B(1,4),B(1,5),B(1,6),B(1,7),B(1,8))
- IF (IERR .EQ. 0) GO TO 160
-C
-C IF INVERSE ITERATION GIVES AN ERROR IN DETERMINING THE
-C EIGENVECTORS, TRY THE QL ALGORITHM IF ALL THE EIGENVECTORS
-C ARE DESIRED.
-C
- IF (NVECT .NE. N) RETURN
- DO 120 I = 1, NVECT
- DO 100 J = 1, N
- VECT(I,J) = ZERO
- 100 CONTINUE
- VECT(I,I) = ONE
- 120 CONTINUE
- CALL TQL2 (NV,N,B(1,1),B(1,2),VECT,IERR)
- DO 140 I = 1, NVECT
- ROOT(I) = B(I,1)
- 140 CONTINUE
- IF (IERR .NE. 0) RETURN
- 160 CALL TRBK3B(NV,N,(N*N+N)/2,A,NVECT,VECT)
- RETURN
- END
-C*MODULE EIGEN *DECK GLDIAG
- SUBROUTINE GLDIAG(LDVECT,NVECT,N,H,WRK,EIG,VECTOR,IERR,IWRK)
-C
- IMPLICIT DOUBLE PRECISION (A-H,O-Z)
-C
- LOGICAL GOPARR,DSKWRK,MASWRK
-C
- DIMENSION H(*),WRK(N,8),EIG(N),VECTOR(LDVECT,NVECT),IWRK(N)
-C
- COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
- COMMON /MACHSW/ KDIAG,ICORFL,IXDR
- COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
-C
-C ----- GENERAL ROUTINE TO DIAGONALIZE A SYMMETRIC MATRIX -----
-C IF KDIAG = 0, USE A ROUTINE FROM THE VECTOR LIBRARY,
-C IF AVAILABLE (SEE THE SUBROUTINE 'GLDIAG'
-C IN VECTOR.SRC), OR EVVRSP OTHERWISE
-C = 1, USE EVVRSP
-C = 2, USE GIVEIS
-C = 3, USE JACOBI
-C
-C N = DIMENSION (ORDER) OF MATRIX TO BE SOLVED
-C LDVECT = LEADING DIMENSION OF VECTOR
-C NVECT = NUMBER OF VECTORS DESIRED
-C H = MATRIX TO BE DIAGONALIZED
-C WRK = N*8 W.P. REAL WORDS OF SCRATCH SPACE
-C EIG = EIGENVECTORS (OUTPUT)
-C VECTOR = EIGENVECTORS (OUTPUT)
-C IERR = ERROR FLAG (OUTPUT)
-C IWRK = N INTEGER WORDS OF SCRATCH SPACE
-C
- IERR = 0
-C
-C ----- USE STEVE ELBERT'S ROUTINE -----
-C
- IF(KDIAG.LE.1 .OR. KDIAG.GT.3) THEN
- LENH = (N*N+N)/2
- KORDER =0
- CALL EVVRSP(IW,N,NVECT,LENH,LDVECT,H,WRK,IWRK,EIG,VECTOR
- * ,KORDER,IERR)
- END IF
-C
-C ----- USE MODIFIED EISPAK ROUTINE -----
-C
- IF(KDIAG.EQ.2)
- * CALL GIVEIS(N,NVECT,LDVECT,H,WRK,IWRK,EIG,VECTOR,IERR)
-C
-C ----- USE JACOBI ROTATION ROUTINE -----
-C
- IF(KDIAG.EQ.3) THEN
- IF(NVECT.EQ.N) THEN
- CALL JACDG(H,VECTOR,EIG,IWRK,WRK,LDVECT,N)
- ELSE
- IF (MASWRK) WRITE(IW,9000) N,NVECT,LDVECT
- CALL ABRT
- END IF
- END IF
- RETURN
-C
- 9000 FORMAT(1X,'IN -GLDIAG-, N,NVECT,LDVECT=',3I8/
- * 1X,'THE JACOBI CODE CANNOT COPE WITH N.NE.NVECT!'/
- * 1X,'SO THIS RUN DOES NOT PERMIT KDIAG=3.')
- END
-C*MODULE EIGEN *DECK IMTQLV
- SUBROUTINE IMTQLV(N,D,E,E2,W,IND,IERR,RV1)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- INTEGER TAG
- DOUBLE PRECISION MACHEP
- DIMENSION D(N),E(N),E2(N),W(N),RV1(N),IND(N)
-C
-C THIS ROUTINE IS A VARIANT OF IMTQL1 WHICH IS A TRANSLATION OF
-C ALGOL PROCEDURE IMTQL1, NUM. MATH. 12, 377-383(1968) BY MARTIN AND
-C WILKINSON, AS MODIFIED IN NUM. MATH. 15, 450(1970) BY DUBRULLE.
-C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 241-248(1971).
-C
-C THIS ROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC TRIDIAGONAL
-C MATRIX BY THE IMPLICIT QL METHOD AND ASSOCIATES WITH THEM
-C THEIR CORRESPONDING SUBMATRIX INDICES.
-C
-C ON INPUT-
-C
-C N IS THE ORDER OF THE MATRIX,
-C
-C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX,
-C
-C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX
-C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY,
-C
-C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E.
-C E2(1) IS ARBITRARY.
-C
-C ON OUTPUT-
-C
-C D AND E ARE UNALTERED,
-C
-C ELEMENTS OF E2, CORRESPONDING TO ELEMENTS OF E REGARDED
-C AS NEGLIGIBLE, HAVE BEEN REPLACED BY ZERO CAUSING THE
-C MATRIX TO SPLIT INTO A DIRECT SUM OF SUBMATRICES.
-C E2(1) IS ALSO SET TO ZERO,
-C
-C W CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN
-C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND
-C ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE
-C THE SMALLEST EIGENVALUES,
-C
-C IND CONTAINS THE SUBMATRIX INDICES ASSOCIATED WITH THE
-C CORRESPONDING EIGENVALUES IN W -- 1 FOR EIGENVALUES
-C BELONGING TO THE FIRST SUBMATRIX FROM THE TOP,
-C 2 FOR THOSE BELONGING TO THE SECOND SUBMATRIX, ETC.,
-C
-C IERR IS SET TO
-C ZERO FOR NORMAL RETURN,
-C J IF THE J-TH EIGENVALUE HAS NOT BEEN
-C DETERMINED AFTER 30 ITERATIONS,
-C
-C RV1 IS A TEMPORARY STORAGE ARRAY.
-C
-C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW,
-C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
-C
-C ------------------------------------------------------------------
-C
-C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING
-C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC.
-C
-C **********
- MACHEP = 2.0D+00**(-50)
-C
- IERR = 0
- K = 0
- TAG = 0
-C
- DO 100 I = 1, N
- W(I) = D(I)
- IF (I .NE. 1) RV1(I-1) = E(I)
- 100 CONTINUE
-C
- E2(1) = 0.0D+00
- RV1(N) = 0.0D+00
-C
- DO 360 L = 1, N
- J = 0
-C ********** LOOK FOR SMALL SUB-DIAGONAL ELEMENT **********
- 120 DO 140 M = L, N
- IF (M .EQ. N) GO TO 160
- IF (ABS(RV1(M)) .LE. MACHEP * (ABS(W(M)) + ABS(W(M+1)))) GO TO
- + 160
-C ********** GUARD AGAINST UNDERFLOWED ELEMENT OF E2 **********
- IF (E2(M+1) .EQ. 0.0D+00) GO TO 180
- 140 CONTINUE
-C
- 160 IF (M .LE. K) GO TO 200
- IF (M .NE. N) E2(M+1) = 0.0D+00
- 180 K = M
- TAG = TAG + 1
- 200 P = W(L)
- IF (M .EQ. L) GO TO 280
- IF (J .EQ. 30) GO TO 380
- J = J + 1
-C ********** FORM SHIFT **********
- G = (W(L+1) - P) / (2.0D+00 * RV1(L))
- R = SQRT(G*G+1.0D+00)
- G = W(M) - P + RV1(L) / (G + SIGN(R,G))
- S = 1.0D+00
- C = 1.0D+00
- P = 0.0D+00
- MML = M - L
-C ********** FOR I=M-1 STEP -1 UNTIL L DO -- **********
- DO 260 II = 1, MML
- I = M - II
- F = S * RV1(I)
- B = C * RV1(I)
- IF (ABS(F) .LT. ABS(G)) GO TO 220
- C = G / F
- R = SQRT(C*C+1.0D+00)
- RV1(I+1) = F * R
- S = 1.0D+00 / R
- C = C * S
- GO TO 240
- 220 S = F / G
- R = SQRT(S*S+1.0D+00)
- RV1(I+1) = G * R
- C = 1.0D+00 / R
- S = S * C
- 240 G = W(I+1) - P
- R = (W(I) - G) * S + 2.0D+00 * C * B
- P = S * R
- W(I+1) = G + P
- G = C * R - B
- 260 CONTINUE
-C
- W(L) = W(L) - P
- RV1(L) = G
- RV1(M) = 0.0D+00
- GO TO 120
-C ********** ORDER EIGENVALUES **********
- 280 IF (L .EQ. 1) GO TO 320
-C ********** FOR I=L STEP -1 UNTIL 2 DO -- **********
- DO 300 II = 2, L
- I = L + 2 - II
- IF (P .GE. W(I-1)) GO TO 340
- W(I) = W(I-1)
- IND(I) = IND(I-1)
- 300 CONTINUE
-C
- 320 I = 1
- 340 W(I) = P
- IND(I) = TAG
- 360 CONTINUE
-C
- GO TO 400
-C ********** SET ERROR -- NO CONVERGENCE TO AN
-C EIGENVALUE AFTER 30 ITERATIONS **********
- 380 IERR = L
- 400 RETURN
-C ********** LAST CARD OF IMTQLV **********
- END
-C*MODULE EIGEN *DECK JACDG
- SUBROUTINE JACDG(A,VEC,EIG,JBIG,BIG,LDVEC,N)
-C
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
-C
- DIMENSION A(*),VEC(LDVEC,N),EIG(N),JBIG(N),BIG(N)
-C
- PARAMETER (ONE=1.0D+00)
-C
-C ----- JACOBI DIAGONALIZATION OF SYMMETRIC MATRIX -----
-C SYMMETRIC MATRIX -A- OF DIMENSION -N- IS DESTROYED ON EXIT.
-C ALL EIGENVECTORS ARE FOUND, SO -VEC- MUST BE SQUARE,
-C UNLESS SOMEONE TAKES THE TROUBLE TO LOOK AT -NMAX- BELOW.
-C -BIG- AND -JBIG- ARE SCRATCH WORK ARRAYS.
-C
- CALL VCLR(VEC,1,LDVEC*N)
- DO 20 I = 1,N
- VEC(I,I) = ONE
- 20 CONTINUE
-C
- NB1 = N
- NB2 = (NB1*NB1+NB1)/2
- NMIN = 1
- NMAX = NB1
-C
- CALL JACDIA(A,VEC,NB1,NB2,LDVEC,NMIN,NMAX,BIG,JBIG)
-C
- DO 30 I=1,N
- EIG(I) = A((I*I+I)/2)
- 30 CONTINUE
-C
- CALL JACORD(VEC,EIG,NB1,LDVEC)
- RETURN
- END
-C*MODULE EIGEN *DECK JACDIA
- SUBROUTINE JACDIA(F,VEC,NB1,NB2,LDVEC,NMIN,NMAX,BIG,JBIG)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- LOGICAL GOPARR,DSKWRK,MASWRK
- DIMENSION F(NB2),VEC(LDVEC,NB1),BIG(NB1),JBIG(NB1)
-C
- COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
-C
- PARAMETER (ROOT2=0.707106781186548D+00 )
- PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, D1050=1.05D+00,
- * D1500=1.5D+00, D3875=3.875D+00,
- * D0500=0.5D+00, D1375=1.375D+00, D0250=0.25D+00 )
- PARAMETER (C2=1.0D-12, C3=4.0D-16,
- * C4=2.0D-16, C5=8.0D-09, C6=3.0D-06 )
-C
-C F IS THE MATRIX TO BE DIAGONALIZED, F IS STORED TRIANGULAR
-C VEC IS THE ARRAY OF EIGENVECTORS, DIMENSION NB1*NB1
-C BIG AND JBIG ARE TEMPORARY SCRATCH AREAS OF DIMENSION NB1
-C THE ROTATIONS AMONG THE FIRST NMIN BASIS FUNCTIONS ARE NOT
-C ACCOUNTED FOR.
-C THE ROTATIONS AMONG THE LAST NB1-NMAX BASIS FUNCTIONS ARE NOT
-C ACCOUNTED FOR.
-C
- IEAA=0
- IEAB=0
- TT=ZERO
- EPS = 64.0D+00*EPSLON(ONE)
-C
-C LOOP OVER COLUMNS (K) OF TRIANGULAR MATRIX TO DETERMINE
-C LARGEST OFF-DIAGONAL ELEMENTS IN ROW(I).
-C
- DO 20 I=1,NB1
- BIG(I)=ZERO
- JBIG(I)=0
- IF(I.LT.NMIN .OR. I.EQ.1) GO TO 20
- II = (I*I-I)/2
- J=MIN(I-1,NMAX)
- DO 10 K=1,J
- IF(ABS(BIG(I)).GE.ABS(F(II+K))) GO TO 10
- BIG(I)=F(II+K)
- JBIG(I)=K
- 10 CONTINUE
- 20 CONTINUE
-C
-C ----- 2X2 JACOBI ITERATIONS BEGIN HERE -----
-C
- MAXIT=MAX(NB2*20,500)
- ITER=0
- 30 CONTINUE
- ITER=ITER+1
-C
-C FIND SMALLEST DIAGONAL ELEMENT
-C
- SD=D1050
- JJ=0
- DO 40 J=1,NB1
- JJ=JJ+J
- SD= MIN(SD,ABS(F(JJ)))
- 40 CONTINUE
- TEST = MAX(EPS, C2*MAX(SD,C6))
-C
-C FIND LARGEST OFF-DIAGONAL ELEMENT
-C
- T=ZERO
- I1=MAX(2,NMIN)
- IB = I1
- DO 50 I=I1,NB1
- IF(T.GE.ABS(BIG(I))) GO TO 50
- T= ABS(BIG(I))
- IB=I
- 50 CONTINUE
-C
-C TEST FOR CONVERGENCE, THEN DETERMINE ROTATION.
-C
- IF(T.LT.TEST) RETURN
-C ******
-C
- IF(ITER.GT.MAXIT) THEN
- IF (MASWRK) THEN
- WRITE(6,*) 'JACOBI DIAGONALIZATION FAILS, DIMENSION=',NB1
- WRITE(6,9020) ITER,T,TEST,SD
- ENDIF
- CALL ABRT
- STOP
- END IF
-C
- IA=JBIG(IB)
- IAA=IA*(IA-1)/2
- IBB=IB*(IB-1)/2
- DIF=F(IAA+IA)-F(IBB+IB)
- IF(ABS(DIF).GT.C3*T) GO TO 70
- SX=ROOT2
- CX=ROOT2
- GO TO 110
- 70 T2X2=BIG(IB)/DIF
- T2X25=T2X2*T2X2
- IF(T2X25 . GT . C4) GO TO 80
- CX=ONE
- SX=T2X2
- GO TO 110
- 80 IF(T2X25 . GT . C5) GO TO 90
- SX=T2X2*(ONE-D1500*T2X25)
- CX=ONE-D0500*T2X25
- GO TO 110
- 90 IF(T2X25 . GT . C6) GO TO 100
- CX=ONE+T2X25*(T2X25*D1375 - D0500)
- SX= T2X2*(ONE + T2X25*(T2X25*D3875 - D1500))
- GO TO 110
- 100 T=D0250 / SQRT(D0250 + T2X25)
- CX= SQRT(D0500 + T)
- SX= SIGN( SQRT(D0500 - T),T2X2)
- 110 IEAR=IAA+1
- IEBR=IBB+1
-C
- DO 230 IR=1,NB1
- T=F(IEAR)*SX
- F(IEAR)=F(IEAR)*CX+F(IEBR)*SX
- F(IEBR)=T-F(IEBR)*CX
- IF(IR-IA) 220,120,130
- 120 TT=F(IEBR)
- IEAA=IEAR
- IEAB=IEBR
- F(IEBR)=BIG(IB)
- IEAR=IEAR+IR-1
- IF(JBIG(IR)) 200,220,200
- 130 T=F(IEAR)
- IT=IA
- IEAR=IEAR+IR-1
- IF(IR-IB) 180,150,160
- 150 F(IEAA)=F(IEAA)*CX+F(IEAB)*SX
- F(IEAB)=TT*CX+F(IEBR)*SX
- F(IEBR)=TT*SX-F(IEBR)*CX
- IEBR=IEBR+IR-1
- GO TO 200
- 160 IF( ABS(T) . GE . ABS(F(IEBR))) GO TO 170
- IF(IB.GT.NMAX) GO TO 170
- T=F(IEBR)
- IT=IB
- 170 IEBR=IEBR+IR-1
- 180 IF( ABS(T) . LT . ABS(BIG(IR))) GO TO 190
- BIG(IR) = T
- JBIG(IR) = IT
- GO TO 220
- 190 IF(IA . NE . JBIG(IR) . AND . IB . NE . JBIG(IR)) GO TO 220
- 200 KQ=IEAR-IR-IA+1
- BIG(IR)=ZERO
- IR1=MIN(IR-1,NMAX)
- DO 210 I=1,IR1
- K=KQ+I
- IF(ABS(BIG(IR)) . GE . ABS(F(K))) GO TO 210
- BIG(IR) = F(K)
- JBIG(IR)=I
- 210 CONTINUE
- 220 IEAR=IEAR+1
- 230 IEBR=IEBR+1
-C
- DO 240 I=1,NB1
- T1=VEC(I,IA)*CX + VEC(I,IB)*SX
- T2=VEC(I,IA)*SX - VEC(I,IB)*CX
- VEC(I,IA)=T1
- VEC(I,IB)=T2
- 240 CONTINUE
- GO TO 30
-C
- 9020 FORMAT(1X,'ITER=',I6,' T,TEST,SD=',1P,3E20.10)
- END
-C*MODULE EIGEN *DECK JACORD
- SUBROUTINE JACORD(VEC,EIG,N,LDVEC)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION VEC(LDVEC,N),EIG(N)
-C
-C ---- SORT EIGENDATA INTO ASCENDING ORDER -----
-C
- DO 290 I = 1, N
- JJ = I
- DO 270 J = I, N
- IF (EIG(J) .LT. EIG(JJ)) JJ = J
- 270 CONTINUE
- IF (JJ .EQ. I) GO TO 290
- T = EIG(JJ)
- EIG(JJ) = EIG(I)
- EIG(I) = T
- DO 280 J = 1, N
- T = VEC(J,JJ)
- VEC(J,JJ) = VEC(J,I)
- VEC(J,I) = T
- 280 CONTINUE
- 290 CONTINUE
- RETURN
- END
-C*MODULE EIGEN *DECK TINVTB
- SUBROUTINE TINVTB(NM,N,D,E,E2,M,W,IND,Z,
- * IERR,RV1,RV2,RV3,RV4,RV6)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION D(N),E(N),E2(N),W(M),Z(NM,M),
- * RV1(N),RV2(N),RV3(N),RV4(N),RV6(N),IND(M)
- DOUBLE PRECISION MACHEP,NORM
- INTEGER P,Q,R,S,TAG,GROUP
-C ------------------------------------------------------------------
-C
-C THIS ROUTINE IS A TRANSLATION OF THE INVERSE ITERATION TECH-
-C NIQUE IN THE ALGOL PROCEDURE TRISTURM BY PETERS AND WILKINSON.
-C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 418-439(1971).
-C
-C THIS ROUTINE FINDS THOSE EIGENVECTORS OF A TRIDIAGONAL
-C SYMMETRIC MATRIX CORRESPONDING TO SPECIFIED EIGENVALUES,
-C USING INVERSE ITERATION.
-C
-C ON INPUT-
-C
-C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL
-C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE
-C DIMENSION STATEMENT,
-C
-C N IS THE ORDER OF THE MATRIX,
-C
-C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX,
-C
-C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX
-C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY,
-C
-C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E,
-C WITH ZEROS CORRESPONDING TO NEGLIGIBLE ELEMENTS OF E.
-C E(I) IS CONSIDERED NEGLIGIBLE IF IT IS NOT LARGER THAN
-C THE PRODUCT OF THE RELATIVE MACHINE PRECISION AND THE SUM
-C OF THE MAGNITUDES OF D(I) AND D(I-1). E2(1) MUST CONTAIN
-C 0.0 IF THE EIGENVALUES ARE IN ASCENDING ORDER, OR 2.0
-C IF THE EIGENVALUES ARE IN DESCENDING ORDER. IF BISECT,
-C TRIDIB, OR IMTQLV HAS BEEN USED TO FIND THE EIGENVALUES,
-C THEIR OUTPUT E2 ARRAY IS EXACTLY WHAT IS EXPECTED HERE,
-C
-C M IS THE NUMBER OF SPECIFIED EIGENVALUES,
-C
-C W CONTAINS THE M EIGENVALUES IN ASCENDING OR DESCENDING ORDER,
-C
-C IND CONTAINS IN ITS FIRST M POSITIONS THE SUBMATRIX INDICES
-C ASSOCIATED WITH THE CORRESPONDING EIGENVALUES IN W --
-C 1 FOR EIGENVALUES BELONGING TO THE FIRST SUBMATRIX FROM
-C THE TOP, 2 FOR THOSE BELONGING TO THE SECOND SUBMATRIX, ETC.
-C
-C ON OUTPUT-
-C
-C ALL INPUT ARRAYS ARE UNALTERED,
-C
-C Z CONTAINS THE ASSOCIATED SET OF ORTHONORMAL EIGENVECTORS.
-C ANY VECTOR WHICH FAILS TO CONVERGE IS SET TO ZERO,
-C
-C IERR IS SET TO
-C ZERO FOR NORMAL RETURN,
-C -R IF THE EIGENVECTOR CORRESPONDING TO THE R-TH
-C EIGENVALUE FAILS TO CONVERGE IN 5 ITERATIONS,
-C
-C RV1, RV2, RV3, RV4, AND RV6 ARE TEMPORARY STORAGE ARRAYS.
-C
-C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW,
-C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
-C
-C ------------------------------------------------------------------
-C
-C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING
-C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC.
-C
-C **********
- MACHEP = 2.0D+00**(-50)
-C
- IERR = 0
- IF (M .EQ. 0) GO TO 680
- TAG = 0
- ORDER = 1.0D+00 - E2(1)
- XU = 0.0D+00
- UK = 0.0D+00
- X0 = 0.0D+00
- U = 0.0D+00
- EPS2 = 0.0D+00
- EPS3 = 0.0D+00
- EPS4 = 0.0D+00
- GROUP = 0
- Q = 0
-C ********** ESTABLISH AND PROCESS NEXT SUBMATRIX **********
- 100 P = Q + 1
- IP = P + 1
-C
- DO 120 Q = P, N
- IF (Q .EQ. N) GO TO 140
- IF (E2(Q+1) .EQ. 0.0D+00) GO TO 140
- 120 CONTINUE
-C ********** FIND VECTORS BY INVERSE ITERATION **********
- 140 TAG = TAG + 1
- IQMP = Q - P + 1
- S = 0
-C
- DO 660 R = 1, M
- IF (IND(R) .NE. TAG) GO TO 660
- ITS = 1
- X1 = W(R)
- IF (S .NE. 0) GO TO 220
-C ********** CHECK FOR ISOLATED ROOT **********
- XU = 1.0D+00
- IF (P .NE. Q) GO TO 160
- RV6(P) = 1.0D+00
- GO TO 600
- 160 NORM = ABS(D(P))
-C
- DO 180 I = IP, Q
- 180 NORM = NORM + ABS(D(I)) + ABS(E(I))
-C ********** EPS2 IS THE CRITERION FOR GROUPING,
-C EPS3 REPLACES ZERO PIVOTS AND EQUAL
-C ROOTS ARE MODIFIED BY EPS3,
-C EPS4 IS TAKEN VERY SMALL TO AVOID OVERFLOW **********
- EPS2 = 1.0D-03 * NORM
- EPS3 = MACHEP * NORM
- UK = IQMP
- EPS4 = UK * EPS3
- UK = EPS4 / SQRT(UK)
- S = P
- 200 GROUP = 0
- GO TO 240
-C ********** LOOK FOR CLOSE OR COINCIDENT ROOTS **********
- 220 IF (ABS(X1-X0) .GE. EPS2) GO TO 200
- GROUP = GROUP + 1
- IF (ORDER * (X1 - X0) .LE. 0.0D+00) X1 = X0 + ORDER * EPS3
-C ********** ELIMINATION WITH INTERCHANGES AND
-C INITIALIZATION OF VECTOR **********
- 240 V = 0.0D+00
-C
- DO 300 I = P, Q
- RV6(I) = UK
- IF (I .EQ. P) GO TO 280
- IF (ABS(E(I)) .LT. ABS(U)) GO TO 260
-C ********** WARNING -- A DIVIDE CHECK MAY OCCUR HERE IF
-C E2 ARRAY HAS NOT BEEN SPECIFIED CORRECTLY **********
- XU = U / E(I)
- RV4(I) = XU
- RV1(I-1) = E(I)
- RV2(I-1) = D(I) - X1
- RV3(I-1) = 0.0D+00
- IF (I .NE. Q) RV3(I-1) = E(I+1)
- U = V - XU * RV2(I-1)
- V = -XU * RV3(I-1)
- GO TO 300
- 260 XU = E(I) / U
- RV4(I) = XU
- RV1(I-1) = U
- RV2(I-1) = V
- RV3(I-1) = 0.0D+00
- 280 U = D(I) - X1 - XU * V
- IF (I .NE. Q) V = E(I+1)
- 300 CONTINUE
-C
- IF (U .EQ. 0.0D+00) U = EPS3
- RV1(Q) = U
- RV2(Q) = 0.0D+00
- RV3(Q) = 0.0D+00
-C ********** BACK SUBSTITUTION
-C FOR I=Q STEP -1 UNTIL P DO -- **********
- 320 DO 340 II = P, Q
- I = P + Q - II
- RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I)
- V = U
- U = RV6(I)
- 340 CONTINUE
-C ********** ORTHOGONALIZE WITH RESPECT TO PREVIOUS
-C MEMBERS OF GROUP **********
- IF (GROUP .EQ. 0) GO TO 400
- J = R
-C
- DO 380 JJ = 1, GROUP
- 360 J = J - 1
- IF (IND(J) .NE. TAG) GO TO 360
- XU = DDOT(IQMP,RV6(P),1,Z(P,J),1)
-C
- CALL DAXPY(IQMP,-XU,Z(P,J),1,RV6(P),1)
-C
- 380 CONTINUE
-C
- 400 NORM = 0.0D+00
-C
- DO 420 I = P, Q
- 420 NORM = NORM + ABS(RV6(I))
-C
- IF (NORM .GE. 1.0D+00) GO TO 560
-C ********** FORWARD SUBSTITUTION **********
- IF (ITS .EQ. 5) GO TO 540
- IF (NORM .NE. 0.0D+00) GO TO 440
- RV6(S) = EPS4
- S = S + 1
- IF (S .GT. Q) S = P
- GO TO 480
- 440 XU = EPS4 / NORM
-C
- DO 460 I = P, Q
- 460 RV6(I) = RV6(I) * XU
-C ********** ELIMINATION OPERATIONS ON NEXT VECTOR
-C ITERATE **********
- 480 DO 520 I = IP, Q
- U = RV6(I)
-C ********** IF RV1(I-1) .EQ. E(I), A ROW INTERCHANGE
-C WAS PERFORMED EARLIER IN THE
-C TRIANGULARIZATION PROCESS **********
- IF (RV1(I-1) .NE. E(I)) GO TO 500
- U = RV6(I-1)
- RV6(I-1) = RV6(I)
- 500 RV6(I) = U - RV4(I) * RV6(I-1)
- 520 CONTINUE
-C
- ITS = ITS + 1
- GO TO 320
-C ********** SET ERROR -- NON-CONVERGED EIGENVECTOR **********
- 540 IERR = -R
- XU = 0.0D+00
- GO TO 600
-C ********** NORMALIZE SO THAT SUM OF SQUARES IS
-C 1 AND EXPAND TO FULL ORDER **********
- 560 U = 0.0D+00
-C
- DO 580 I = P, Q
- RV6(I) = RV6(I) / NORM
- 580 U = U + RV6(I)**2
-C
- XU = 1.0D+00 / SQRT(U)
-C
- 600 DO 620 I = 1, N
- 620 Z(I,R) = 0.0D+00
-C
- DO 640 I = P, Q
- 640 Z(I,R) = RV6(I) * XU
-C
- X0 = X1
- 660 CONTINUE
-C
- IF (Q .LT. N) GO TO 100
- 680 RETURN
-C ********** LAST CARD OF TINVIT **********
- END
-C*MODULE EIGEN *DECK TQL2
-C
-C ------------------------------------------------------------------
-C
- SUBROUTINE TQL2(NM,N,D,E,Z,IERR)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DOUBLE PRECISION MACHEP
- DIMENSION D(N),E(N),Z(NM,N)
-C
-C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TQL2,
-C NUM. MATH. 11, 293-306(1968) BY BOWDLER, MARTIN, REINSCH, AND
-C WILKINSON.
-C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 227-240(1971).
-C
-C THIS ROUTINE FINDS THE EIGENVALUES AND EIGENVECTORS
-C OF A SYMMETRIC TRIDIAGONAL MATRIX BY THE QL METHOD.
-C THE EIGENVECTORS OF A FULL SYMMETRIC MATRIX CAN ALSO
-C BE FOUND IF TRED2 HAS BEEN USED TO REDUCE THIS
-C FULL MATRIX TO TRIDIAGONAL FORM.
-C
-C ON INPUT-
-C
-C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL
-C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE
-C DIMENSION STATEMENT,
-C
-C N IS THE ORDER OF THE MATRIX,
-C
-C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX,
-C
-C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX
-C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY,
-C
-C Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE
-C REDUCTION BY TRED2, IF PERFORMED. IF THE EIGENVECTORS
-C OF THE TRIDIAGONAL MATRIX ARE DESIRED, Z MUST CONTAIN
-C THE IDENTITY MATRIX.
-C
-C ON OUTPUT-
-C
-C D CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN
-C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT BUT
-C UNORDERED FOR INDICES 1,2,...,IERR-1,
-C
-C E HAS BEEN DESTROYED,
-C
-C Z CONTAINS ORTHONORMAL EIGENVECTORS OF THE SYMMETRIC
-C TRIDIAGONAL (OR FULL) MATRIX. IF AN ERROR EXIT IS MADE,
-C Z CONTAINS THE EIGENVECTORS ASSOCIATED WITH THE STORED
-C EIGENVALUES,
-C
-C IERR IS SET TO
-C ZERO FOR NORMAL RETURN,
-C J IF THE J-TH EIGENVALUE HAS NOT BEEN
-C DETERMINED AFTER 30 ITERATIONS.
-C
-C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW,
-C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
-C
-C ------------------------------------------------------------------
-C
-C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING
-C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC.
-C
-C **********
- MACHEP = 2.0D+00**(-50)
-C
- IERR = 0
- IF (N .EQ. 1) GO TO 400
-C
- DO 100 I = 2, N
- 100 E(I-1) = E(I)
-C
- F = 0.0D+00
- B = 0.0D+00
- E(N) = 0.0D+00
-C
- DO 300 L = 1, N
- J = 0
- H = MACHEP * (ABS(D(L)) + ABS(E(L)))
- IF (B .LT. H) B = H
-C ********** LOOK FOR SMALL SUB-DIAGONAL ELEMENT **********
- DO 120 M = L, N
- IF (ABS(E(M)) .LE. B) GO TO 140
-C ********** E(N) IS ALWAYS ZERO, SO THERE IS NO EXIT
-C THROUGH THE BOTTOM OF THE LOOP **********
- 120 CONTINUE
-C
- 140 IF (M .EQ. L) GO TO 280
- 160 IF (J .EQ. 30) GO TO 380
- J = J + 1
-C ********** FORM SHIFT **********
- L1 = L + 1
- G = D(L)
- P = (D(L1) - G) / (2.0D+00 * E(L))
- R = SQRT(P*P+1.0D+00)
- D(L) = E(L) / (P + SIGN(R,P))
- H = G - D(L)
-C
- DO 180 I = L1, N
- 180 D(I) = D(I) - H
-C
- F = F + H
-C ********** QL TRANSFORMATION **********
- P = D(M)
- C = 1.0D+00
- S = 0.0D+00
- MML = M - L
-C ********** FOR I=M-1 STEP -1 UNTIL L DO -- **********
- DO 260 II = 1, MML
- I = M - II
- G = C * E(I)
- H = C * P
- IF (ABS(P) .LT. ABS(E(I))) GO TO 200
- C = E(I) / P
- R = SQRT(C*C+1.0D+00)
- E(I+1) = S * P * R
- S = C / R
- C = 1.0D+00 / R
- GO TO 220
- 200 C = P / E(I)
- R = SQRT(C*C+1.0D+00)
- E(I+1) = S * E(I) * R
- S = 1.0D+00 / R
- C = C * S
- 220 P = C * D(I) - S * G
- D(I+1) = H + S * (C * G + S * D(I))
-C ********** FORM VECTOR **********
- CALL DROT(N,Z(1,I+1),1,Z(1,I),1,C,S)
-C
- 260 CONTINUE
-C
- E(L) = S * P
- D(L) = C * P
- IF (ABS(E(L)) .GT. B) GO TO 160
- 280 D(L) = D(L) + F
- 300 CONTINUE
-C ********** ORDER EIGENVALUES AND EIGENVECTORS **********
- DO 360 II = 2, N
- I = II - 1
- K = I
- P = D(I)
-C
- DO 320 J = II, N
- IF (D(J) .GE. P) GO TO 320
- K = J
- P = D(J)
- 320 CONTINUE
-C
- IF (K .EQ. I) GO TO 360
- D(K) = D(I)
- D(I) = P
-C
- CALL DSWAP(N,Z(1,I),1,Z(1,K),1)
-C
- 360 CONTINUE
-C
- GO TO 400
-C ********** SET ERROR -- NO CONVERGENCE TO AN
-C EIGENVALUE AFTER 30 ITERATIONS **********
- 380 IERR = L
- 400 RETURN
-C ********** LAST CARD OF TQL2 **********
- END
-C*MODULE EIGEN *DECK TRBK3B
-C
-C ------------------------------------------------------------------
-C
- SUBROUTINE TRBK3B(NM,N,NV,A,M,Z)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION A(NV),Z(NM,M)
-C
-C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRBAK3,
-C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON.
-C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
-C
-C THIS ROUTINE FORMS THE EIGENVECTORS OF A REAL SYMMETRIC
-C MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING
-C SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY TRED3B.
-C
-C ON INPUT-
-C
-C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL
-C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE
-C DIMENSION STATEMENT,
-C
-C N IS THE ORDER OF THE MATRIX,
-C
-C NV MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A
-C AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT,
-C
-C A CONTAINS INFORMATION ABOUT THE ORTHOGONAL TRANSFORMATIONS
-C USED IN THE REDUCTION BY TRED3B IN ITS FIRST
-C N*(N+1)/2 POSITIONS,
-C
-C M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED,
-C
-C Z CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED
-C IN ITS FIRST M COLUMNS.
-C
-C ON OUTPUT-
-C
-C Z CONTAINS THE TRANSFORMED EIGENVECTORS
-C IN ITS FIRST M COLUMNS.
-C
-C NOTE THAT TRBAK3 PRESERVES VECTOR EUCLIDEAN NORMS.
-C
-C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW,
-C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
-C
-C ------------------------------------------------------------------
-C
- IF (M .EQ. 0) GO TO 140
- IF (N .EQ. 1) GO TO 140
-C
- DO 120 I = 2, N
- L = I - 1
- IZ = (I * L) / 2
- IK = IZ + I
- H = A(IK)
- IF (H .EQ. 0.0D+00) GO TO 120
-C
- DO 100 J = 1, M
- S = -DDOT(L,A(IZ+1),1,Z(1,J),1)
-C
-C ********** DOUBLE DIVISION AVOIDS POSSIBLE UNDERFLOW **********
- S = (S / H) / H
-C
- CALL DAXPY(L,S,A(IZ+1),1,Z(1,J),1)
-C
- 100 CONTINUE
-C
- 120 CONTINUE
-C
- 140 RETURN
-C ********** LAST CARD OF TRBAK3 **********
- END
-C*MODULE EIGEN *DECK TRED3B
-C
-C ------------------------------------------------------------------
-C
- SUBROUTINE TRED3B(N,NV,A,D,E,E2)
- IMPLICIT DOUBLE PRECISION(A-H,O-Z)
- DIMENSION A(NV),D(N),E(N),E2(N)
-C
-C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRED3,
-C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON.
-C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
-C
-C THIS ROUTINE REDUCES A REAL SYMMETRIC MATRIX, STORED AS
-C A ONE-DIMENSIONAL ARRAY, TO A SYMMETRIC TRIDIAGONAL MATRIX
-C USING ORTHOGONAL SIMILARITY TRANSFORMATIONS.
-C
-C ON INPUT-
-C
-C N IS THE ORDER OF THE MATRIX,
-C
-C NV MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A
-C AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT,
-C
-C A CONTAINS THE LOWER TRIANGLE OF THE REAL SYMMETRIC
-C INPUT MATRIX, STORED ROW-WISE AS A ONE-DIMENSIONAL
-C ARRAY, IN ITS FIRST N*(N+1)/2 POSITIONS.
-C
-C ON OUTPUT-
-C
-C A CONTAINS INFORMATION ABOUT THE ORTHOGONAL
-C TRANSFORMATIONS USED IN THE REDUCTION,
-C
-C D CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX,
-C
-C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL
-C MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO,
-C
-C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E.
-C E2 MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED.
-C
-C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW,
-C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
-C
-C ------------------------------------------------------------------
-C
-C ********** FOR I=N STEP -1 UNTIL 1 DO -- **********
- DO 300 II = 1, N
- I = N + 1 - II
- L = I - 1
- IZ = (I * L) / 2
- H = 0.0D+00
- SCALE = 0.0D+00
- IF (L .LT. 1) GO TO 120
-C ********** SCALE ROW (ALGOL TOL THEN NOT NEEDED) **********
- DO 100 K = 1, L
- IZ = IZ + 1
- D(K) = A(IZ)
- SCALE = SCALE + ABS(D(K))
- 100 CONTINUE
-C
- IF (SCALE .NE. 0.0D+00) GO TO 140
- 120 E(I) = 0.0D+00
- E2(I) = 0.0D+00
- GO TO 280
-C
- 140 DO 160 K = 1, L
- D(K) = D(K) / SCALE
- H = H + D(K) * D(K)
- 160 CONTINUE
-C
- E2(I) = SCALE * SCALE * H
- F = D(L)
- G = -SIGN(SQRT(H),F)
- E(I) = SCALE * G
- H = H - F * G
- D(L) = F - G
- A(IZ) = SCALE * D(L)
- IF (L .EQ. 1) GO TO 280
- F = 0.0D+00
-C
- JK = 1
- DO 220 J = 1, L
- JM1 = J - 1
- DT = D(J)
- G = 0.0D+00
-C ********** FORM ELEMENT OF A*U **********
- IF (JM1 .EQ. 0) GO TO 200
- DO 180 K = 1, JM1
- E(K) = E(K) + DT * A(JK)
- G = G + D(K) * A(JK)
- JK = JK + 1
- 180 CONTINUE
- 200 E(J) = G + A(JK) * DT
- JK = JK + 1
-C ********** FORM ELEMENT OF P **********
- 220 CONTINUE
- F = 0.0D+00
- DO 240 J = 1, L
- E(J) = E(J) / H
- F = F + E(J) * D(J)
- 240 CONTINUE
-C
- HH = F / (H + H)
- JK = 0
-C ********** FORM REDUCED A **********
- DO 260 J = 1, L
- F = D(J)
- G = E(J) - HH * F
- E(J) = G
-C
- DO 260 K = 1, J
- JK = JK + 1
- A(JK) = A(JK) - F * E(K) - G * D(K)
- 260 CONTINUE
-C
- 280 D(I) = A(IZ+1)
- A(IZ+1) = SCALE * SQRT(H)
- 300 CONTINUE
-C
- RETURN
-C ********** LAST CARD OF TRED3 **********
- END
+++ /dev/null
- subroutine elecont(lprint,ncont,icont)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.FFIELD'
- include 'COMMON.NAMES'
- logical lprint
- double precision elpp_6(2,2),elpp_3(2,2),ael6_(2,2),ael3_(2,2)
- double precision app_(2,2),bpp_(2,2),rpp_(2,2)
- integer ncont,icont(2,maxcont)
- double precision econt(maxcont)
-*
-* Load the constants of peptide bond - peptide bond interactions.
-* Type 1 - ordinary peptide bond, type 2 - alkylated peptide bond (e.g.
-* proline) - determined by averaging ECEPP energy.
-*
-* as of 7/06/91.
-*
-c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/
- data rpp_ / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/
- data elpp_6 /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/
- data elpp_3 / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/
- data elcutoff /-0.3d0/,elecutoff_14 /-0.5d0/
- if (lprint) write (iout,'(a)')
- & "Constants of electrostatic interaction energy expression."
- do i=1,2
- do j=1,2
- rri=rpp_(i,j)**6
- app_(i,j)=epp(i,j)*rri*rri
- bpp_(i,j)=-2.0*epp(i,j)*rri
- ael6_(i,j)=elpp_6(i,j)*4.2**6
- ael3_(i,j)=elpp_3(i,j)*4.2**3
- if (lprint)
- & write (iout,'(2i2,4e15.4)') i,j,app_(i,j),bpp_(i,j),ael6_(i,j),
- & ael3_(i,j)
- enddo
- enddo
- ncont=0
- ees=0.0
- evdw=0.0
- do 1 i=nnt,nct-2
- xi=c(1,i)
- yi=c(2,i)
- zi=c(3,i)
- dxi=c(1,i+1)-c(1,i)
- dyi=c(2,i+1)-c(2,i)
- dzi=c(3,i+1)-c(3,i)
- xmedi=xi+0.5*dxi
- ymedi=yi+0.5*dyi
- zmedi=zi+0.5*dzi
- do 4 j=i+2,nct-1
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- if (iteli.eq.2 .and. itelj.eq.2) goto 4
- aaa=app_(iteli,itelj)
- bbb=bpp_(iteli,itelj)
- ael6_i=ael6_(iteli,itelj)
- ael3_i=ael3_(iteli,itelj)
- dxj=c(1,j+1)-c(1,j)
- dyj=c(2,j+1)-c(2,j)
- dzj=c(3,j+1)-c(3,j)
- xj=c(1,j)+0.5*dxj-xmedi
- yj=c(2,j)+0.5*dyj-ymedi
- zj=c(3,j)+0.5*dzj-zmedi
- rrmij=1.0/(xj*xj+yj*yj+zj*zj)
- rmij=sqrt(rrmij)
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- vrmij=vblinv*rmij
- cosa=(dxi*dxj+dyi*dyj+dzi*dzj)*vblinv2
- cosb=(xj*dxi+yj*dyi+zj*dzi)*vrmij
- cosg=(xj*dxj+yj*dyj+zj*dzj)*vrmij
- fac=cosa-3.0*cosb*cosg
- ev1=aaa*r6ij*r6ij
- ev2=bbb*r6ij
- fac3=ael6_i*r6ij
- fac4=ael3_i*r3ij
- evdwij=ev1+ev2
- el1=fac3*(4.0+fac*fac-3.0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- eesij=el1+el2
- if (j.gt.i+2 .and. eesij.le.elcutoff .or.
- & j.eq.i+2 .and. eesij.le.elecutoff_14) then
- ncont=ncont+1
- icont(1,ncont)=i
- icont(2,ncont)=j
- econt(ncont)=eesij
- endif
- ees=ees+eesij
- evdw=evdw+evdwij
- 4 continue
- 1 continue
- if (lprint) then
- write (iout,*) 'Total average electrostatic energy: ',ees
- write (iout,*) 'VDW energy between peptide-group centers: ',evdw
- write (iout,*)
- write (iout,*) 'Electrostatic contacts before pruning: '
- do i=1,ncont
- i1=icont(1,i)
- i2=icont(2,i)
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)')
- & i,restyp(it1),i1,restyp(it2),i2,econt(i)
- enddo
- endif
-c For given residues keep only the contacts with the greatest energy.
- i=0
- do while (i.lt.ncont)
- i=i+1
- ene=econt(i)
- ic1=icont(1,i)
- ic2=icont(2,i)
- j=i
- do while (j.lt.ncont)
- j=j+1
- if (ic1.eq.icont(1,j).and.iabs(icont(2,j)-ic2).le.2 .or.
- & ic2.eq.icont(2,j).and.iabs(icont(1,j)-ic1).le.2) then
-c write (iout,*) "i",i," j",j," ic1",ic1," ic2",ic2,
-c & " jc1",icont(1,j)," jc2",icont(2,j)," ncont",ncont
- if (econt(j).lt.ene .and. icont(2,j).ne.icont(1,j)+2) then
- if (ic1.eq.icont(1,j)) then
- do k=1,ncont
- if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.icont(2,j)
- & .and. iabs(icont(1,k)-ic1).le.2 .and.
- & econt(k).lt.econt(j) ) goto 21
- enddo
- else if (ic2.eq.icont(2,j) ) then
- do k=1,ncont
- if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.icont(1,j)
- & .and. iabs(icont(2,k)-ic2).le.2 .and.
- & econt(k).lt.econt(j) ) goto 21
- enddo
- endif
-c Remove ith contact
- do k=i+1,ncont
- icont(1,k-1)=icont(1,k)
- icont(2,k-1)=icont(2,k)
- econt(k-1)=econt(k)
- enddo
- i=i-1
- ncont=ncont-1
-c write (iout,*) "ncont",ncont
-c do k=1,ncont
-c write (iout,*) icont(1,k),icont(2,k)
-c enddo
- goto 20
- else if (econt(j).gt.ene .and. ic2.ne.ic1+2)
- & then
- if (ic1.eq.icont(1,j)) then
- do k=1,ncont
- if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.ic2
- & .and. iabs(icont(1,k)-icont(1,j)).le.2 .and.
- & econt(k).lt.econt(i) ) goto 21
- enddo
- else if (ic2.eq.icont(2,j) ) then
- do k=1,ncont
- if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.ic1
- & .and. iabs(icont(2,k)-icont(2,j)).le.2 .and.
- & econt(k).lt.econt(i) ) goto 21
- enddo
- endif
-c Remove jth contact
- do k=j+1,ncont
- icont(1,k-1)=icont(1,k)
- icont(2,k-1)=icont(2,k)
- econt(k-1)=econt(k)
- enddo
- ncont=ncont-1
-c write (iout,*) "ncont",ncont
-c do k=1,ncont
-c write (iout,*) icont(1,k),icont(2,k)
-c enddo
- j=j-1
- endif
- endif
- 21 continue
- enddo
- 20 continue
- enddo
- if (lprint) then
- write (iout,*)
- write (iout,*) 'Electrostatic contacts after pruning: '
- do i=1,ncont
- i1=icont(1,i)
- i2=icont(2,i)
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)')
- & i,restyp(it1),i1,restyp(it2),i2,econt(i)
- enddo
- endif
- return
- end
-c--------------------------------------------
- subroutine secondary2(lprint)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.CONTROL'
- integer ncont,icont(2,maxcont),isec(maxres,4),nsec(maxres)
- logical lprint,not_done,freeres
- double precision p1,p2
- external freeres
-
- if(.not.dccart) call chainbuild
-cd call write_pdb(99,'sec structure',0d0)
- ncont=0
- nbfrag=0
- nhfrag=0
- do i=1,nres
- isec(i,1)=0
- isec(i,2)=0
- nsec(i)=0
- enddo
-
- call elecont(lprint,ncont,icont)
-
-c finding parallel beta
-cd write (iout,*) '------- looking for parallel beta -----------'
- nbeta=0
- nstrand=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if(j1-i1.gt.5 .and. freeres(i1,j1,nsec,isec)) then
- ii1=i1
- jj1=j1
-cd write (iout,*) i1,j1
- not_done=.true.
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) .and.
- & freeres(i1,j1,nsec,isec)) goto 5
- enddo
- not_done=.false.
- 5 continue
-cd write (iout,*) i1,j1,not_done
- enddo
- j1=j1-1
- i1=i1-1
- if (i1-ii1.gt.1) then
- ii1=max0(ii1-1,1)
- jj1=max0(jj1-1,1)
- nbeta=nbeta+1
- if(lprint)write(iout,'(a,i3,4i4)')'parallel beta',
- & nbeta,ii1,i1,jj1,j1
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=ii1+1
- bfrag(2,nbfrag)=i1+1
- bfrag(3,nbfrag)=jj1+1
- bfrag(4,nbfrag)=min0(j1+1,nres)
-
- do ij=ii1,i1
- nsec(ij)=nsec(ij)+1
- isec(ij,nsec(ij))=nbeta
- enddo
- do ij=jj1,j1
- nsec(ij)=nsec(ij)+1
- isec(ij,nsec(ij))=nbeta
- enddo
-
- if(lprint) then
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-1,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-1,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",jj1-1,"..",j1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",jj1-1,"..",j1-1,"'"
- endif
- write(12,'(a8,4i4)')
- & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1
- endif
- endif
- endif
- enddo
-
-c finding alpha or 310 helix
-
- nhelix=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- p1=phi(i1+2)*rad2deg
- p2=0.0
- if (j1+2.le.nres) p2=phi(j1+2)*rad2deg
-
-
- if (j1.eq.i1+3 .and.
- & ((p1.ge.10.and.p1.le.80).or.i1.le.2).and.
- & ((p2.ge.10.and.p2.le.80).or.j1.le.2.or.j1.ge.nres-3) )then
-cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,p1,p2
-co if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,p1,p2
- ii1=i1
- jj1=j1
- if (nsec(ii1).eq.0) then
- not_done=.true.
- else
- not_done=.false.
- endif
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10
- enddo
- not_done=.false.
- 10 continue
- p1=phi(i1+2)*rad2deg
- p2=phi(j1+2)*rad2deg
- if (p1.lt.10.or.p1.gt.80.or.p2.lt.10.or.p2.gt.80)
- & not_done=.false.
-cd write (iout,*) i1,j1,not_done,p1,p2
- enddo
- j1=j1+1
- if (j1-ii1.gt.5) then
- nhelix=nhelix+1
-cd write (iout,*)'helix',nhelix,ii1,j1
-
- nhfrag=nhfrag+1
- hfrag(1,nhfrag)=ii1
- hfrag(2,nhfrag)=j1
-
- do ij=ii1,j1
- nsec(ij)=-1
- enddo
- if (lprint) then
- write (iout,'(a,i3,2i4)') "Helix",nhelix,ii1-1,j1-1
- if (nhelix.le.9) then
- write(12,'(a17,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'helix",nhelix,
- & "' 'num = ",ii1-1,"..",j1-2,"'"
- else
- write(12,'(a17,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'helix",nhelix,
- & "' 'num = ",ii1-1,"..",j1-2,"'"
- endif
- endif
- endif
- endif
- enddo
-
- if (nhelix.gt.0.and.lprint) then
- write(12,'(a26,$)') "DefPropRes 'helix' 'helix1"
- do i=2,nhelix
- if (nhelix.le.9) then
- write(12,'(a8,i1,$)') " | helix",i
- else
- write(12,'(a8,i2,$)') " | helix",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
-
-c finding antiparallel beta
-cd write (iout,*) '--------- looking for antiparallel beta ---------'
-
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (freeres(i1,j1,nsec,isec)) then
- ii1=i1
- jj1=j1
-cd write (iout,*) i1,j1
-
- not_done=.true.
- do while (not_done)
- i1=i1+1
- j1=j1-1
- do j=1,ncont
- if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and.
- & freeres(i1,j1,nsec,isec)) goto 6
- enddo
- not_done=.false.
- 6 continue
-cd write (iout,*) i1,j1,not_done
- enddo
- i1=i1-1
- j1=j1+1
- if (i1-ii1.gt.1) then
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=ii1
- bfrag(2,nbfrag)=min0(i1+1,nres)
- bfrag(3,nbfrag)=min0(jj1+1,nres)
- bfrag(4,nbfrag)=j1
-
- nbeta=nbeta+1
- iii1=max0(ii1-1,1)
- do ij=iii1,i1
- nsec(ij)=nsec(ij)+1
- if (nsec(ij).le.2) then
- isec(ij,nsec(ij))=nbeta
- endif
- enddo
- jjj1=max0(j1-1,1)
- do ij=jjj1,jj1
- nsec(ij)=nsec(ij)+1
- if (nsec(ij).le.2 .and. nsec(ij).gt.0) then
- isec(ij,nsec(ij))=nbeta
- endif
- enddo
-
-
- if (lprint) then
- write (iout,'(a,i3,4i4)')'antiparallel beta',
- & nbeta,ii1-1,i1,jj1,j1-1
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-2,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-2,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",j1-2,"..",jj1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",j1-2,"..",jj1-1,"'"
- endif
- write(12,'(a8,4i4)')
- & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2
- endif
- endif
- endif
- enddo
-
- if (nstrand.gt.0.and.lprint) then
- write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1"
- do i=2,nstrand
- if (i.le.9) then
- write(12,'(a9,i1,$)') " | strand",i
- else
- write(12,'(a9,i2,$)') " | strand",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
-
-
- if (lprint) then
- write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'"
- write(12,'(a20)') "XMacStand ribbon.mac"
-
-
- write(iout,*) 'UNRES seq:'
- do j=1,nbfrag
- write(iout,*) 'beta ',(bfrag(i,j),i=1,4)
- enddo
-
- do j=1,nhfrag
- write(iout,*) 'helix ',(hfrag(i,j),i=1,2)
- enddo
- endif
-
- return
- end
-c-------------------------------------------------
- logical function freeres(i,j,nsec,isec)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- integer isec(maxres,4),nsec(maxres)
- freeres=.false.
-
- if (nsec(i).lt.0.or.nsec(j).lt.0) return
- if (nsec(i).gt.1.or.nsec(j).gt.1) return
- do k=1,nsec(i)
- do l=1,nsec(j)
- if (isec(i,k).eq.isec(j,l)) return
- enddo
- enddo
- freeres=.true.
- return
- end
-
+++ /dev/null
-C-----------------------------------------------------------------------
- double precision function sscale(r)
- double precision r,gamm
- include "COMMON.SPLITELE"
- if(r.lt.r_cut-rlamb) then
- sscale=1.0d0
- else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
- gamm=(r-(r_cut-rlamb))/rlamb
- sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
- else
- sscale=0d0
- endif
- return
- end
-C-----------------------------------------------------------------------
- subroutine elj_long(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
-cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
-cd & 'iend=',iend(i,iint)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rij=xj*xj+yj*yj+zj*zj
- sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
- if (sss.lt.1.0d0) then
- rrij=1.0D0/rij
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e1+e2
- evdw=evdw+(1.0d0-sss)*evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-rrij*(e1+evdwij)*(1.0d0-sss)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time, the factor of EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
-C-----------------------------------------------------------------------
- subroutine elj_short(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C Change 12/1/95
- num_conti=0
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
-cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
-cd & 'iend=',iend(i,iint)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
-C Change 12/1/95 to calculate four-body interactions
- rij=xj*xj+yj*yj+zj*zj
- sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
- if (sss.gt.0.0d0) then
- rrij=1.0D0/rij
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e1+e2
- evdw=evdw+sss*evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-rrij*(e1+evdwij)*sss
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time, the factor of EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eljk_long(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJK potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- dimension gg(3)
- logical scheck
-c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- sss=sscale(rij/sigma(itypi,itypj))
- if (sss.lt.1.0d0) then
- r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
- fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e_augm+e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
-cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+(1.0d0-sss)*evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- fac=fac*(1.0d0-sss)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eljk_short(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJK potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- dimension gg(3)
- logical scheck
-c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- sss=sscale(rij/sigma(itypi,itypj))
- if (sss.gt.0.0d0) then
- r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
- fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e_augm+e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
-cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
- evdw=evdw+sss*evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- fac=fac*sss
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine ebp_long(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Berne-Pechukas potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
-c double precision rrsave(maxdim)
- logical lprn
- evdw=0.0D0
-c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-c if (icall.eq.0) then
-c lprn=.true.
-c else
- lprn=.false.
-c endif
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.lt.1.0d0) then
-
-C Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*(1.0d0-sss)
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & epsi,sigm,chi1,chi2,chip1,chip2,
-cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-cd & om1,om2,om12,1.0D0/dsqrt(rrij),
-cd & evdwij
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-C Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate the angular part of the gradient and sum add the contributions
-C to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(1.0d0-sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c stop
- return
- end
-C-----------------------------------------------------------------------------
- subroutine ebp_short(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Berne-Pechukas potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
-c double precision rrsave(maxdim)
- logical lprn
- evdw=0.0D0
-c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-c if (icall.eq.0) then
-c lprn=.true.
-c else
- lprn=.false.
-c endif
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.gt.0.0d0) then
-
-C Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij*sss
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & epsi,sigm,chi1,chi2,chip1,chip2,
-cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-cd & om1,om2,om12,1.0D0/dsqrt(rrij),
-cd & evdwij
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-C Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate the angular part of the gradient and sum add the contributions
-C to the appropriate components of the Cartesian gradient.
- call sc_grad_scale(sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c stop
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egb_long(evdw,evdw_p,evdw_m)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.CONTROL'
- logical lprn
-ccccc energy_dec=.false.
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- evdw_p=0.0D0
- evdw_m=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.false.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
-c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c & 1.0d0/vbld(j+nres)
-c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.lt.1.0d0) then
-
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-c for diagnostics; uncomment
-c rij_shift=1.2*sig0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
-c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
- evdwij=evdwij*eps2rt*eps3rt
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- evdw_p=evdw_p+evdwij*(1.0d0-sss)
- else
- evdw_m=evdw_m+evdwij*(1.0d0-sss)
- endif
-#else
- evdw=evdw+evdwij*(1.0d0-sss)
-#endif
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij
- endif
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
-
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
-c fac=0.0d0
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- call sc_grad_scale_T(1.0d0-sss)
- else
- call sc_grad_scale(1.0d0-sss)
- endif
-#else
- call sc_grad_scale(1.0d0-sss)
-#endif
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c write (iout,*) "Number of loop steps in EGB:",ind
-cccc energy_dec=.false.
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egb_short(evdw,evdw_p,evdw_m)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.CONTROL'
- logical lprn
- evdw=0.0D0
- evdw_p=0.0D0
- evdw_m=0.0D0
-ccccc energy_dec=.false.
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.false.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
-c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c & 1.0d0/vbld(j+nres)
-c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.gt.0.0d0) then
-
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-c for diagnostics; uncomment
-c rij_shift=1.2*sig0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
-c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
- evdwij=evdwij*eps2rt*eps3rt
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- evdw_p=evdw_p+evdwij*sss
- else
- evdw_m=evdw_m+evdwij*sss
- endif
-#else
- evdw=evdw+evdwij*sss
-#endif
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij
- endif
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
-
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
-c fac=0.0d0
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- call sc_grad_scale_T(sss)
- else
- call sc_grad_scale(sss)
- endif
-#else
- call sc_grad_scale(sss)
-#endif
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c write (iout,*) "Number of loop steps in EGB:",ind
-cccc energy_dec=.false.
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egbv_long(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne-Vorobjev potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
- logical lprn
- evdw=0.0D0
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.lt.1.0d0) then
-
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
- & chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij+e_augm
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad_scale(1.0d0-sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- end
-C-----------------------------------------------------------------------------
- subroutine egbv_short(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne-Vorobjev potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
- logical lprn
- evdw=0.0D0
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-
- sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
-
- if (sss.gt.0.0d0) then
-
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+(evdwij+e_augm)*sss
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
- & chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij+e_augm
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad_scale(sss)
- endif
- enddo ! j
- enddo ! iint
- enddo ! i
- end
-C----------------------------------------------------------------------------
- subroutine sc_grad_scale(scalfac)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- double precision dcosom1(3),dcosom2(3)
- double precision scalfac
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
- & -2.0D0*alf12*eps3der+sigder*sigsq_om12
-c diagnostics only
-c eom1=0.0d0
-c eom2=0.0d0
-c eom12=evdwij*eps1_om12
-c end diagnostics
-c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
-c & " sigder",sigder
-c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- do k=1,3
- gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac
- enddo
-c write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac
-c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
-c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
-c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
- enddo
- return
- end
-C----------------------------------------------------------------------------
- subroutine sc_grad_scale_T(scalfac)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- double precision dcosom1(3),dcosom2(3)
- double precision scalfac
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
- & -2.0D0*alf12*eps3der+sigder*sigsq_om12
-c diagnostics only
-c eom1=0.0d0
-c eom2=0.0d0
-c eom12=evdwij*eps1_om12
-c end diagnostics
-c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
-c & " sigder",sigder
-c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- do k=1,3
- gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac
- enddo
-c write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac
- gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac
-c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
-c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
-c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
- do l=1,3
- gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
- gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
- enddo
- return
- end
-
-C--------------------------------------------------------------------------
- subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-C
-C This subroutine calculates the average interaction energy and its gradient
-C in the virtual-bond vectors between non-adjacent peptide groups, based on
-C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
-C The potential depends both on the distance of peptide-group centers and on
-C the orientation of the CA-CA virtual bonds.
-C
- implicit real*8 (a-h,o-z)
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-cd write(iout,*) 'In EELEC'
-cd do i=1,nloctyp
-cd write(iout,*) 'Type',i
-cd write(iout,*) 'B1',B1(:,i)
-cd write(iout,*) 'B2',B2(:,i)
-cd write(iout,*) 'CC',CC(:,:,i)
-cd write(iout,*) 'DD',DD(:,:,i)
-cd write(iout,*) 'EE',EE(:,:,i)
-cd enddo
-cd call check_vecgrad
-cd stop
- if (icheckgrad.eq.1) then
- do i=1,nres-1
- fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
- do k=1,3
- dc_norm(k,i)=dc(k,i)*fac
- enddo
-c write (iout,*) 'i',i,' fac',fac
- enddo
- endif
- if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
- & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
-c call vec_and_deriv
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call set_matrices
-#ifdef TIMING
- time_mat=time_mat+MPI_Wtime()-time01
-#endif
- endif
-cd do i=1,nres-1
-cd write (iout,*) 'i=',i
-cd do k=1,3
-cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
-cd enddo
-cd do k=1,3
-cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
-cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
-cd enddo
-cd enddo
- t_eelecij=0.0d0
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- ind=0
- do i=1,nres
- num_cont_hb(i)=0
- enddo
-cd print '(a)','Enter EELEC'
-cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- enddo
-c
-c
-c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
-C
-C Loop over i,i+2 and i,i+3 pairs of the peptide groups
-C
- do i=iturn3_start,iturn3_end
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
- call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
- if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
- num_cont_hb(i)=num_conti
- enddo
- do i=iturn4_start,iturn4_end
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=num_cont_hb(i)
- call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
- num_cont_hb(i)=num_conti
- enddo ! i
-c
-c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
-c
- do i=iatel_s,iatel_e
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
- num_conti=num_cont_hb(i)
- do j=ielstart(i),ielend(i)
- call eelecij_scale(i,j,ees,evdw1,eel_loc)
- enddo ! j
- num_cont_hb(i)=num_conti
- enddo ! i
-c write (iout,*) "Number of loop steps in EELEC:",ind
-cd do i=1,nres
-cd write (iout,'(i3,3f10.5,5x,3f10.5)')
-cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
-cd enddo
-c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
-ccc eel_loc=eel_loc+eello_turn3
-cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
- return
- end
-C-------------------------------------------------------------------------------
- subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-c time00=MPI_Wtime()
-cd write (iout,*) "eelecij",i,j
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- ael6i=ael6(iteli,itelj)
- ael3i=ael3(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- rrmij=1.0D0/rij
- rij=dsqrt(rij)
- rmij=1.0D0/rij
-c For extracting the short-range part of Evdwpp
- sss=sscale(rij/rpp(iteli,itelj))
-
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
- cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
- cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
- fac=cosa-3.0D0*cosb*cosg
- ev1=aaa*r6ij*r6ij
-c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- fac3=ael6i*r6ij
- fac4=ael3i*r3ij
- evdwij=ev1+ev2
- el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- eesij=el1+el2
-C 12/26/95 - for the evaluation of multi-body H-bonding interactions
- ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
- ees=ees+eesij
- evdw1=evdw1+evdwij*(1.0d0-sss)
-cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
-cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
-cd & xmedi,ymedi,zmedi,xj,yj,zj
-
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
- write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
- endif
-
-C
-C Calculate contributions to the Cartesian gradient.
-C
-#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
- facel=-3*rrmij*(el1+eesij)
- fac1=fac
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=facel*xj
- ggg(2)=facel*yj
- ggg(3)=facel*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
-c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-#else
- facvdw=ev1+evdwij*(1.0d0-sss)
- facel=el1+eesij
- fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc(k,j)+ggg(k)
- gelc_long(k,i)=gelc(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-#endif
-*
-* Angular part
-*
- ecosa=2.0D0*fac3*fac1+fac4
- fac4=-3.0D0*fac4
- fac3=-6.0D0*fac3
- ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
- ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
-cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
-cd & (dcosg(k),k=1,3)
- do k=1,3
- ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
- enddo
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
-c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
-c gelc(k,j)=gelc(k,j)+ghalf
-c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
-c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
-c enddo
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- do k=1,3
- gelc(k,i)=gelc(k,i)
- & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gelc(k,j)=gelc(k,j)
- & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
- IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
- & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C
-C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
-C energy of a peptide unit is assumed in the form of a second-order
-C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
-C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
-C are computed for EVERY pair of non-contiguous peptide groups.
-C
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- kkk=0
- do k=1,2
- do l=1,2
- kkk=kkk+1
- muij(kkk)=mu(k,i)*mu(l,j)
- enddo
- enddo
-cd write (iout,*) 'EELEC: i',i,' j',j
-cd write (iout,*) 'j',j,' j1',j1,' j2',j2
-cd write(iout,*) 'muij',muij
- ury=scalar(uy(1,i),erij)
- urz=scalar(uz(1,i),erij)
- vry=scalar(uy(1,j),erij)
- vrz=scalar(uz(1,j),erij)
- a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
- a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
- a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
- a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
- fac=dsqrt(-ael6i)*r3ij
- a22=a22*fac
- a23=a23*fac
- a32=a32*fac
- a33=a33*fac
-cd write (iout,'(4i5,4f10.5)')
-cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
-cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
-cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
-cd & uy(:,j),uz(:,j)
-cd write (iout,'(4f10.5)')
-cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
-cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
-cd write (iout,'(4f10.5)') ury,urz,vry,vrz
-cd write (iout,'(9f10.5/)')
-cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
-C Derivatives of the elements of A in virtual-bond vectors
- call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
- do k=1,3
- uryg(k,1)=scalar(erder(1,k),uy(1,i))
- uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
- uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
- urzg(k,1)=scalar(erder(1,k),uz(1,i))
- urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
- urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
- vryg(k,1)=scalar(erder(1,k),uy(1,j))
- vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
- vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
- vrzg(k,1)=scalar(erder(1,k),uz(1,j))
- vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
- vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
- enddo
-C Compute radial contributions to the gradient
- facr=-3.0d0*rrmij
- a22der=a22*facr
- a23der=a23*facr
- a32der=a32*facr
- a33der=a33*facr
- agg(1,1)=a22der*xj
- agg(2,1)=a22der*yj
- agg(3,1)=a22der*zj
- agg(1,2)=a23der*xj
- agg(2,2)=a23der*yj
- agg(3,2)=a23der*zj
- agg(1,3)=a32der*xj
- agg(2,3)=a32der*yj
- agg(3,3)=a32der*zj
- agg(1,4)=a33der*xj
- agg(2,4)=a33der*yj
- agg(3,4)=a33der*zj
-C Add the contributions coming from er
- fac3=-3.0d0*fac
- do k=1,3
- agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
- agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
- agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
- agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
- enddo
- do k=1,3
-C Derivatives in DC(i)
-cgrad ghalf1=0.5d0*agg(k,1)
-cgrad ghalf2=0.5d0*agg(k,2)
-cgrad ghalf3=0.5d0*agg(k,3)
-cgrad ghalf4=0.5d0*agg(k,4)
- aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
- & -3.0d0*uryg(k,2)*vry)!+ghalf1
- aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
- & -3.0d0*uryg(k,2)*vrz)!+ghalf2
- aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
- & -3.0d0*urzg(k,2)*vry)!+ghalf3
- aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
- & -3.0d0*urzg(k,2)*vrz)!+ghalf4
-C Derivatives in DC(i+1)
- aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
- & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
- aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
- & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
- aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
- & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
- aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
- & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
-C Derivatives in DC(j)
- aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
- & -3.0d0*vryg(k,2)*ury)!+ghalf1
- aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
- & -3.0d0*vrzg(k,2)*ury)!+ghalf2
- aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
- & -3.0d0*vryg(k,2)*urz)!+ghalf3
- aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
- & -3.0d0*vrzg(k,2)*urz)!+ghalf4
-C Derivatives in DC(j+1) or DC(nres-1)
- aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
- & -3.0d0*vryg(k,3)*ury)
- aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
- & -3.0d0*vrzg(k,3)*ury)
- aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
- & -3.0d0*vryg(k,3)*urz)
- aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
- & -3.0d0*vrzg(k,3)*urz)
-cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
-cgrad do l=1,4
-cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
-cgrad enddo
-cgrad endif
- enddo
- acipa(1,1)=a22
- acipa(1,2)=a23
- acipa(2,1)=a32
- acipa(2,2)=a33
- a22=-a22
- a23=-a23
- do l=1,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- if (j.lt.nres-1) then
- a22=-a22
- a32=-a32
- do l=1,3,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- else
- a22=-a22
- a23=-a23
- a32=-a32
- a33=-a33
- do l=1,4
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- endif
- ENDIF ! WCORR
- IF (wel_loc.gt.0.0d0) THEN
-C Contribution to the local-electrostatic energy coming from the i-j pair
- eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
- & +a33*muij(4)
-cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eelloc',i,j,eel_loc_ij
-
- eel_loc=eel_loc+eel_loc_ij
-C Partial derivatives in virtual-bond dihedral angles gamma
- if (i.gt.1)
- & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
- & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
- & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
- gel_loc_loc(j-1)=gel_loc_loc(j-1)+
- & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
- & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
-C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
- do l=1,3
- ggg(l)=agg(l,1)*muij(1)+
- & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
- gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
- gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
-cgrad ghalf=0.5d0*ggg(l)
-cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
-cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
- enddo
-cgrad do k=i+1,j2
-cgrad do l=1,3
-cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-C Remaining derivatives of eello
- do l=1,3
- gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
- & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
- gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
- & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
- gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
- & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
- gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
- & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
- enddo
- ENDIF
-C Change 12/26/95 to calculate four-body contributions to H-bonding energy
-c if (j.gt.i+1 .and. num_conti.le.maxconts) then
- if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
- & .and. num_conti.le.maxconts) then
-c write (iout,*) i,j," entered corr"
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-c r0ij=1.02D0*rpp(iteli,itelj)
-c r0ij=1.11D0*rpp(iteli,itelj)
- r0ij=2.20D0*rpp(iteli,itelj)
-c r0ij=1.55D0*rpp(iteli,itelj)
- call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- if (num_conti.gt.maxconts) then
- write (iout,*) 'WARNING - max. # of contacts exceeded;',
- & ' will skip next contacts for this conf.'
- else
- jcont_hb(num_conti,i)=j
-cd write (iout,*) "i",i," j",j," num_conti",num_conti,
-cd & " jcont_hb",jcont_hb(num_conti,i)
- IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
- & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
-C terms.
- d_cont(num_conti,i)=rij
-cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
-C --- Electrostatic-interaction matrix ---
- a_chuj(1,1,num_conti,i)=a22
- a_chuj(1,2,num_conti,i)=a23
- a_chuj(2,1,num_conti,i)=a32
- a_chuj(2,2,num_conti,i)=a33
-C --- Gradient of rij
- do kkk=1,3
- grij_hb_cont(kkk,num_conti,i)=erij(kkk)
- enddo
- kkll=0
- do k=1,2
- do l=1,2
- kkll=kkll+1
- do m=1,3
- a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
- a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
- a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
- a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
- a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
- enddo
- enddo
- enddo
- ENDIF
- IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
-C Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
-c fac3=dsqrt(-ael6i)/r0ij**3
- fac3=dsqrt(-ael6i)*r3ij
-c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
- ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
- if (ees0tmp.gt.0) then
- ees0pij=dsqrt(ees0tmp)
- else
- ees0pij=0
- endif
-c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
- ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
- if (ees0tmp.gt.0) then
- ees0mij=dsqrt(ees0tmp)
- else
- ees0mij=0
- endif
-c ees0mij=0.0D0
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
-C Diagnostics. Comment out or remove after debugging!
-c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
-c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
-c ees0m(num_conti,i)=0.0D0
-C End diagnostics.
-c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
-c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
-C Angular derivatives of the contact function
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrmij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
-c ees0mij1=0.0D0
- ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
- ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
- ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
- ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
- ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
- ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
- ecosap=ecosa1+ecosa2
- ecosbp=ecosb1+ecosb2
- ecosgp=ecosg1+ecosg2
- ecosam=ecosa1-ecosa2
- ecosbm=ecosb1-ecosb2
- ecosgm=ecosg1-ecosg2
-C Diagnostics
-c ecosap=ecosa1
-c ecosbp=ecosb1
-c ecosgp=ecosg1
-c ecosam=0.0D0
-c ecosbm=0.0D0
-c ecosgm=0.0D0
-C End diagnostics
- facont_hb(num_conti,i)=fcont
- fprimcont=fprimcont/rij
-cd facont_hb(num_conti,i)=1.0D0
-C Following line is for diagnostics.
-cd fprimcont=0.0D0
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
- do k=1,3
- gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
- gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
- enddo
- gggp(1)=gggp(1)+ees0pijp*xj
- gggp(2)=gggp(2)+ees0pijp*yj
- gggp(3)=gggp(3)+ees0pijp*zj
- gggm(1)=gggm(1)+ees0mijp*xj
- gggm(2)=gggm(2)+ees0mijp*yj
- gggm(3)=gggm(3)+ees0mijp*zj
-C Derivatives due to the contact function
- gacont_hbr(1,num_conti,i)=fprimcont*xj
- gacont_hbr(2,num_conti,i)=fprimcont*yj
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
-c
-c 10/24/08 cgrad and ! comments indicate the parts of the code removed
-c following the change of gradient-summation algorithm.
-c
-cgrad ghalfp=0.5D0*gggp(k)
-cgrad ghalfm=0.5D0*gggm(k)
- gacontp_hb1(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontp_hb2(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontp_hb3(k,num_conti,i)=gggp(k)
- gacontm_hb1(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontm_hb2(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontm_hb3(k,num_conti,i)=gggm(k)
- enddo
- ENDIF ! wcorr
- endif ! num_conti.le.maxconts
- endif ! fcont.gt.0
- endif ! j.gt.i+1
- if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
- do k=1,4
- do l=1,3
- ghalf=0.5d0*agg(l,k)
- aggi(l,k)=aggi(l,k)+ghalf
- aggi1(l,k)=aggi1(l,k)+agg(l,k)
- aggj(l,k)=aggj(l,k)+ghalf
- enddo
- enddo
- if (j.eq.nres-1 .and. i.lt.j-2) then
- do k=1,4
- do l=1,3
- aggj1(l,k)=aggj1(l,k)+agg(l,k)
- enddo
- enddo
- endif
- endif
-c t_eelecij=t_eelecij+MPI_Wtime()-time00
- return
- end
-C-----------------------------------------------------------------------
- subroutine evdwpp_short(evdw1)
-C
-C Compute Evdwpp
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- dimension ggg(3)
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
- evdw1=0.0D0
-c write (iout,*) "iatel_s_vdw",iatel_s_vdw,
-c & " iatel_e_vdw",iatel_e_vdw
- call flush(iout)
- do i=iatel_s_vdw,iatel_e_vdw
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
-c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
-c & ' ielend',ielend_vdw(i)
- call flush(iout)
- do j=ielstart_vdw(i),ielend_vdw(i)
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- rrmij=1.0D0/rij
- rij=dsqrt(rij)
- sss=sscale(rij/rpp(iteli,itelj))
- if (sss.gt.0.0d0) then
- rmij=1.0D0/rij
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- ev1=aaa*r6ij*r6ij
-c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- evdwij=ev1+ev2
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
- endif
- evdw1=evdw1+evdwij*sss
-C
-C Calculate contributions to the Cartesian gradient.
-C
- facvdw=-6*rrmij*(ev1+evdwij)*sss
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
- endif
- enddo ! j
- enddo ! i
- return
- end
-C-----------------------------------------------------------------------------
- subroutine escp_long(evdw2,evdw2_14)
-C
-C This subroutine calculates the excluded-volume interaction energy between
-C peptide-group centers and side chains and its gradient in virtual-bond and
-C side-chain vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- evdw2=0.0D0
- evdw2_14=0.0d0
-cd print '(a)','Enter ESCP'
-cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
- do i=iatscp_s,iatscp_e
- iteli=itel(i)
- xi=0.5D0*(c(1,i)+c(1,i+1))
- yi=0.5D0*(c(2,i)+c(2,i+1))
- zi=0.5D0*(c(3,i)+c(3,i+1))
-
- do iint=1,nscp_gr(i)
-
- do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
-C Uncomment following three lines for SC-p interactions
-c xj=c(1,nres+j)-xi
-c yj=c(2,nres+j)-yi
-c zj=c(3,nres+j)-zi
-C Uncomment following three lines for Ca-p interactions
- xj=c(1,j)-xi
- yj=c(2,j)-yi
- zj=c(3,j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-
- sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
-
- if (sss.lt.1.0d0) then
-
- fac=rrij**expon2
- e1=fac*fac*aad(itypj,iteli)
- e2=fac*bad(itypj,iteli)
- if (iabs(j-i) .le. 2) then
- e1=scal14*e1
- e2=scal14*e2
- evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
- endif
- evdwij=e1+e2
- evdw2=evdw2+evdwij*(1.0d0-sss)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw2',i,j,evdwij
-C
-C Calculate contributions to the gradient in the virtual-bond and SC vectors.
-C
- fac=-(evdwij+e1)*rrij*(1.0d0-sss)
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-C Uncomment following line for SC-p interactions
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
- do k=1,3
- gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
- gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
- enddo
- endif
- enddo
-
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
- gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
- gradx_scp(j,i)=expon*gradx_scp(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time the factor EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
-C-----------------------------------------------------------------------------
- subroutine escp_short(evdw2,evdw2_14)
-C
-C This subroutine calculates the excluded-volume interaction energy between
-C peptide-group centers and side chains and its gradient in virtual-bond and
-C side-chain vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- evdw2=0.0D0
- evdw2_14=0.0d0
-cd print '(a)','Enter ESCP'
-cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
- do i=iatscp_s,iatscp_e
- iteli=itel(i)
- xi=0.5D0*(c(1,i)+c(1,i+1))
- yi=0.5D0*(c(2,i)+c(2,i+1))
- zi=0.5D0*(c(3,i)+c(3,i+1))
-
- do iint=1,nscp_gr(i)
-
- do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
-C Uncomment following three lines for SC-p interactions
-c xj=c(1,nres+j)-xi
-c yj=c(2,nres+j)-yi
-c zj=c(3,nres+j)-zi
-C Uncomment following three lines for Ca-p interactions
- xj=c(1,j)-xi
- yj=c(2,j)-yi
- zj=c(3,j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-
- sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
-
- if (sss.gt.0.0d0) then
-
- fac=rrij**expon2
- e1=fac*fac*aad(itypj,iteli)
- e2=fac*bad(itypj,iteli)
- if (iabs(j-i) .le. 2) then
- e1=scal14*e1
- e2=scal14*e2
- evdw2_14=evdw2_14+(e1+e2)*sss
- endif
- evdwij=e1+e2
- evdw2=evdw2+evdwij*sss
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw2',i,j,evdwij
-C
-C Calculate contributions to the gradient in the virtual-bond and SC vectors.
-C
- fac=-(evdwij+e1)*rrij*sss
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-C Uncomment following line for SC-p interactions
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
- do k=1,3
- gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
- gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
- enddo
- endif
- enddo
-
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
- gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
- gradx_scp(j,i)=expon*gradx_scp(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time the factor EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
+++ /dev/null
- subroutine etotal(energia)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include "mpif.h"
- double precision weights_(n_ene)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision energia(0:n_ene)
- include 'COMMON.LOCAL'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CONTROL'
- include 'COMMON.TIME1'
-#ifdef MPI
-c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
-c & " nfgtasks",nfgtasks
- if (nfgtasks.gt.1) then
-#ifdef MPI
- time00=MPI_Wtime()
-#else
- time00=tcpu()
-#endif
-C FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (fg_rank.eq.0) then
- call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
-c print *,"Processor",myrank," BROADCAST iorder"
-C FG master sets up the WEIGHTS_ array which will be broadcast to the
-C FG slaves as WEIGHTS array.
- weights_(1)=wsc
- weights_(2)=wscp
- weights_(3)=welec
- weights_(4)=wcorr
- weights_(5)=wcorr5
- weights_(6)=wcorr6
- weights_(7)=wel_loc
- weights_(8)=wturn3
- weights_(9)=wturn4
- weights_(10)=wturn6
- weights_(11)=wang
- weights_(12)=wscloc
- weights_(13)=wtor
- weights_(14)=wtor_d
- weights_(15)=wstrain
- weights_(16)=wvdwpp
- weights_(17)=wbond
- weights_(18)=scal14
- weights_(21)=wsccor
- weights_(22)=wsct
-C FG Master broadcasts the WEIGHTS_ array
- call MPI_Bcast(weights_(1),n_ene,
- & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- else
-C FG slaves receive the WEIGHTS array
- call MPI_Bcast(weights(1),n_ene,
- & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- wsc=weights(1)
- wscp=weights(2)
- welec=weights(3)
- wcorr=weights(4)
- wcorr5=weights(5)
- wcorr6=weights(6)
- wel_loc=weights(7)
- wturn3=weights(8)
- wturn4=weights(9)
- wturn6=weights(10)
- wang=weights(11)
- wscloc=weights(12)
- wtor=weights(13)
- wtor_d=weights(14)
- wstrain=weights(15)
- wvdwpp=weights(16)
- wbond=weights(17)
- scal14=weights(18)
- wsccor=weights(21)
- wsct=weights(22)
- endif
- time_Bcast=time_Bcast+MPI_Wtime()-time00
- time_Bcastw=time_Bcastw+MPI_Wtime()-time00
-c call chainbuild_cart
- endif
-c print *,'Processor',myrank,' calling etotal ipot=',ipot
-c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
-#else
-c if (modecalc.eq.12.or.modecalc.eq.14) then
-c call int_from_cart1(.false.)
-c endif
-#endif
-#ifdef TIMING
-#ifdef MPI
- time00=MPI_Wtime()
-#else
- time00=tcpu()
-#endif
-#endif
-C
-C Compute the side-chain and electrostatic interaction energy
-C
- goto (101,102,103,104,105,106) ipot
-C Lennard-Jones potential.
- 101 call elj(evdw,evdw_p,evdw_m)
-cd print '(a)','Exit ELJ'
- goto 107
-C Lennard-Jones-Kihara potential (shifted).
- 102 call eljk(evdw,evdw_p,evdw_m)
- goto 107
-C Berne-Pechukas potential (dilated LJ, angular dependence).
- 103 call ebp(evdw,evdw_p,evdw_m)
- goto 107
-C Gay-Berne potential (shifted LJ, angular dependence).
- 104 call egb(evdw,evdw_p,evdw_m)
- goto 107
-C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
- 105 call egbv(evdw,evdw_p,evdw_m)
- goto 107
-C Soft-sphere potential
- 106 call e_softsphere(evdw)
-C
-C Calculate electrostatic (H-bonding) energy of the main chain.
-C
- 107 continue
-cmc
-cmc Sep-06: egb takes care of dynamic ss bonds too
-cmc
-c if (dyn_ss) call dyn_set_nss
-
-c print *,"Processor",myrank," computed USCSC"
-#ifdef TIMING
-#ifdef MPI
- time01=MPI_Wtime()
-#else
- time00=tcpu()
-#endif
-#endif
- call vec_and_deriv
-#ifdef TIMING
-#ifdef MPI
- time_vec=time_vec+MPI_Wtime()-time01
-#else
- time_vec=time_vec+tcpu()-time01
-#endif
-#endif
-c print *,"Processor",myrank," left VEC_AND_DERIV"
- if (ipot.lt.6) then
-#ifdef SPLITELE
- if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
- & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
- & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
- & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
-#else
- if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
- & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
- & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
- & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
-#endif
- call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
- else
- ees=0.0d0
- evdw1=0.0d0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- endif
- else
-c write (iout,*) "Soft-spheer ELEC potential"
- call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
- & eello_turn4)
- endif
-c print *,"Processor",myrank," computed UELEC"
-C
-C Calculate excluded-volume interaction energy between peptide groups
-C and side chains.
-C
- if (ipot.lt.6) then
- if(wscp.gt.0d0) then
- call escp(evdw2,evdw2_14)
- else
- evdw2=0
- evdw2_14=0
- endif
- else
-c write (iout,*) "Soft-sphere SCP potential"
- call escp_soft_sphere(evdw2,evdw2_14)
- endif
-c
-c Calculate the bond-stretching energy
-c
- call ebond(estr)
-C
-C Calculate the disulfide-bridge and other energy and the contributions
-C from other distance constraints.
-cd print *,'Calling EHPB'
- call edis(ehpb)
-cd print *,'EHPB exitted succesfully.'
-C
-C Calculate the virtual-bond-angle energy.
-C
- if (wang.gt.0d0) then
- call ebend(ebe)
- else
- ebe=0
- endif
-c print *,"Processor",myrank," computed UB"
-C
-C Calculate the SC local energy.
-C
- call esc(escloc)
-c print *,"Processor",myrank," computed USC"
-C
-C Calculate the virtual-bond torsional energy.
-C
-cd print *,'nterm=',nterm
- if (wtor.gt.0) then
- call etor(etors,edihcnstr)
- else
- etors=0
- edihcnstr=0
- endif
-
- if (constr_homology.ge.1) then
- call e_modeller(ehomology_constr)
- else
- ehomology_constr=0
- endif
-
-
-c write(iout,*) ehomology_constr
-c print *,"Processor",myrank," computed Utor"
-C
-C 6/23/01 Calculate double-torsional energy
-C
- if (wtor_d.gt.0) then
- call etor_d(etors_d)
- else
- etors_d=0
- endif
-c print *,"Processor",myrank," computed Utord"
-C
-C 21/5/07 Calculate local sicdechain correlation energy
-C
- if (wsccor.gt.0.0d0) then
- call eback_sc_corr(esccor)
- else
- esccor=0.0d0
- endif
-c print *,"Processor",myrank," computed Usccorr"
-C
-C 12/1/95 Multi-body terms
-C
- n_corr=0
- n_corr1=0
- if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
- & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
- call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
-cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
-cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
- else
- ecorr=0.0d0
- ecorr5=0.0d0
- ecorr6=0.0d0
- eturn6=0.0d0
- endif
- if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
- call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
-cd write (iout,*) "multibody_hb ecorr",ecorr
- endif
-c print *,"Processor",myrank," computed Ucorr"
-C
-C If performing constraint dynamics, call the constraint energy
-C after the equilibration time
- if(usampl.and.totT.gt.eq_time) then
- call EconstrQ
- call Econstr_back
- else
- Uconst=0.0d0
- Uconst_back=0.0d0
- endif
-#ifdef TIMING
-#ifdef MPI
- time_enecalc=time_enecalc+MPI_Wtime()-time00
-#else
- time_enecalc=time_enecalc+tcpu()-time00
-#endif
-#endif
-c print *,"Processor",myrank," computed Uconstr"
-#ifdef TIMING
-#ifdef MPI
- time00=MPI_Wtime()
-#else
- time00=tcpu()
-#endif
-#endif
-c
-C Sum the energies
-C
- energia(1)=evdw
-#ifdef SCP14
- energia(2)=evdw2-evdw2_14
- energia(18)=evdw2_14
-#else
- energia(2)=evdw2
- energia(18)=0.0d0
-#endif
-#ifdef SPLITELE
- energia(3)=ees
- energia(16)=evdw1
-#else
- energia(3)=ees+evdw1
- energia(16)=0.0d0
-#endif
- energia(4)=ecorr
- energia(5)=ecorr5
- energia(6)=ecorr6
- energia(7)=eel_loc
- energia(8)=eello_turn3
- energia(9)=eello_turn4
- energia(10)=eturn6
- energia(11)=ebe
- energia(12)=escloc
- energia(13)=etors
- energia(14)=etors_d
- energia(15)=ehpb
- energia(19)=edihcnstr
- energia(17)=estr
- energia(20)=Uconst+Uconst_back
- energia(21)=esccor
- energia(22)=evdw_p
- energia(23)=evdw_m
- energia(24)=ehomology_constr
-c print *," Processor",myrank," calls SUM_ENERGY"
- call sum_energy(energia,.true.)
- if (dyn_ss) call dyn_set_nss
-c print *," Processor",myrank," left SUM_ENERGY"
-#ifdef TIMING
-#ifdef MPI
- time_sumene=time_sumene+MPI_Wtime()-time00
-#else
- time_sumene=time_sumene+tcpu()-time00
-#endif
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine sum_energy(energia,reduce)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision energia(0:n_ene),enebuff(0:n_ene+1)
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.TIME1'
- logical reduce
-#ifdef MPI
- if (nfgtasks.gt.1 .and. reduce) then
-#ifdef DEBUG
- write (iout,*) "energies before REDUCE"
- call enerprint(energia)
- call flush(iout)
-#endif
- do i=0,n_ene
- enebuff(i)=energia(i)
- enddo
- time00=MPI_Wtime()
- call MPI_Barrier(FG_COMM,IERR)
- time_barrier_e=time_barrier_e+MPI_Wtime()-time00
- time00=MPI_Wtime()
- call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
-#ifdef DEBUG
- write (iout,*) "energies after REDUCE"
- call enerprint(energia)
- call flush(iout)
-#endif
- time_Reduce=time_Reduce+MPI_Wtime()-time00
- endif
- if (fg_rank.eq.0) then
-#endif
-#ifdef TSCSC
- evdw=energia(22)+wsct*energia(23)
-#else
- evdw=energia(1)
-#endif
-#ifdef SCP14
- evdw2=energia(2)+energia(18)
- evdw2_14=energia(18)
-#else
- evdw2=energia(2)
-#endif
-#ifdef SPLITELE
- ees=energia(3)
- evdw1=energia(16)
-#else
- ees=energia(3)
- evdw1=0.0d0
-#endif
- ecorr=energia(4)
- ecorr5=energia(5)
- ecorr6=energia(6)
- eel_loc=energia(7)
- eello_turn3=energia(8)
- eello_turn4=energia(9)
- eturn6=energia(10)
- ebe=energia(11)
- escloc=energia(12)
- etors=energia(13)
- etors_d=energia(14)
- ehpb=energia(15)
- edihcnstr=energia(19)
- estr=energia(17)
- Uconst=energia(20)
- esccor=energia(21)
- ehomology_constr=energia(24)
-#ifdef SPLITELE
- etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
- & +wang*ebe+wtor*etors+wscloc*escloc
- & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
- & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
- & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
- & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
-#else
- etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
- & +wang*ebe+wtor*etors+wscloc*escloc
- & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
- & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
- & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
- & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr
-#endif
- energia(0)=etot
-c detecting NaNQ
-#ifdef ISNAN
-#ifdef AIX
- if (isnan(etot).ne.0) energia(0)=1.0d+99
-#else
- if (isnan(etot)) energia(0)=1.0d+99
-#endif
-#else
- i=0
-#ifdef WINPGI
- idumm=proc_proc(etot,i)
-#else
- call proc_proc(etot,i)
-#endif
- if(i.eq.1)energia(0)=1.0d+99
-#endif
-#ifdef MPI
- endif
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine sum_gradient
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include 'mpif.h'
-#endif
- double precision gradbufc(3,maxres),gradbufx(3,maxres),
- & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.TIME1'
- include 'COMMON.MAXGRAD'
- include 'COMMON.SCCOR'
-#ifdef TIMING
-#ifdef MPI
- time01=MPI_Wtime()
-#else
- time01=tcpu()
-#endif
-#endif
-#ifdef DEBUG
- write (iout,*) "sum_gradient gvdwc, gvdwx"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
- & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
- & (gvdwcT(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-#ifdef MPI
-C FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (nfgtasks.gt.1 .and. fg_rank.eq.0)
- & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
-C
-C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
-C in virtual-bond-vector coordinates
-C
-#ifdef DEBUG
-c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
-c do i=1,nres-1
-c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
-c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
-c enddo
-c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
-c do i=1,nres-1
-c write (iout,'(i5,3f10.5,2x,f10.5)')
-c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
-c enddo
- write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
- do i=1,nres
- write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
- & g_corr5_loc(i)
- enddo
- call flush(iout)
-#endif
-#ifdef SPLITELE
-#ifdef TSCSC
- do i=1,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
- & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
- & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
- enddo
- enddo
-#else
- do i=1,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+
- & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
- & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
- enddo
- enddo
-#endif
-#else
- do i=1,nct
- do j=1,3
- gradbufc(j,i)=wsc*gvdwc(j,i)+
- & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
- & welec*gelc_long(j,i)+
- & wbond*gradb(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i)+
- & wstrain*ghpbc(j,i)
- enddo
- enddo
-#endif
-#ifdef MPI
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-#ifdef DEBUG
- write (iout,*) "gradbufc before allreduce"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
- do i=1,nres
- do j=1,3
- gradbufc_sum(j,i)=gradbufc(j,i)
- enddo
- enddo
-c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
-c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
-c time_reduce=time_reduce+MPI_Wtime()-time00
-#ifdef DEBUG
-c write (iout,*) "gradbufc_sum after allreduce"
-c do i=1,nres
-c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
-c enddo
-c call flush(iout)
-#endif
-#ifdef TIMING
-c time_allreduce=time_allreduce+MPI_Wtime()-time00
-#endif
- do i=nnt,nres
- do k=1,3
- gradbufc(k,i)=0.0d0
- enddo
- enddo
-#ifdef DEBUG
- write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
- write (iout,*) (i," jgrad_start",jgrad_start(i),
- & " jgrad_end ",jgrad_end(i),
- & i=igrad_start,igrad_end)
-#endif
-c
-c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
-c do not parallelize this part.
-c
-c do i=igrad_start,igrad_end
-c do j=jgrad_start(i),jgrad_end(i)
-c do k=1,3
-c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
-c enddo
-c enddo
-c enddo
- do j=1,3
- gradbufc(j,nres-1)=gradbufc_sum(j,nres)
- enddo
- do i=nres-2,nnt,-1
- do j=1,3
- gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
- enddo
- enddo
-#ifdef DEBUG
- write (iout,*) "gradbufc after summing"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
- else
-#endif
-#ifdef DEBUG
- write (iout,*) "gradbufc"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
- do i=1,nres
- do j=1,3
- gradbufc_sum(j,i)=gradbufc(j,i)
- gradbufc(j,i)=0.0d0
- enddo
- enddo
- do j=1,3
- gradbufc(j,nres-1)=gradbufc_sum(j,nres)
- enddo
- do i=nres-2,nnt,-1
- do j=1,3
- gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
- enddo
- enddo
-c do i=nnt,nres-1
-c do k=1,3
-c gradbufc(k,i)=0.0d0
-c enddo
-c do j=i+1,nres
-c do k=1,3
-c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
-c enddo
-c enddo
-c enddo
-#ifdef DEBUG
- write (iout,*) "gradbufc after summing"
- do i=1,nres
- write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
- enddo
- call flush(iout)
-#endif
-#ifdef MPI
- endif
-#endif
- do k=1,3
- gradbufc(k,nres)=0.0d0
- enddo
- do i=1,nct
- do j=1,3
-#ifdef SPLITELE
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
- & wel_loc*gel_loc(j,i)+
- & 0.5d0*(wscp*gvdwc_scpp(j,i)+
- & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gradcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i))+
- & wbond*gradb(j,i)+
- & wcorr*gradcorr(j,i)+
- & wturn3*gcorr3_turn(j,i)+
- & wturn4*gcorr4_turn(j,i)+
- & wcorr5*gradcorr5(j,i)+
- & wcorr6*gradcorr6(j,i)+
- & wturn6*gcorr6_turn(j,i)+
- & wsccor*gsccorc(j,i)
- & +wscloc*gscloc(j,i)
-#else
- gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
- & wel_loc*gel_loc(j,i)+
- & 0.5d0*(wscp*gvdwc_scpp(j,i)+
- & welec*gelc_long(j,i)+
- & wel_loc*gel_loc_long(j,i)+
- & wcorr*gcorr_long(j,i)+
- & wcorr5*gradcorr5_long(j,i)+
- & wcorr6*gradcorr6_long(j,i)+
- & wturn6*gcorr6_turn_long(j,i))+
- & wbond*gradb(j,i)+
- & wcorr*gradcorr(j,i)+
- & wturn3*gcorr3_turn(j,i)+
- & wturn4*gcorr4_turn(j,i)+
- & wcorr5*gradcorr5(j,i)+
- & wcorr6*gradcorr6(j,i)+
- & wturn6*gcorr6_turn(j,i)+
- & wsccor*gsccorc(j,i)
- & +wscloc*gscloc(j,i)
-#endif
-#ifdef TSCSC
- gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
- & wscp*gradx_scp(j,i)+
- & wbond*gradbx(j,i)+
- & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
- & wsccor*gsccorx(j,i)
- & +wscloc*gsclocx(j,i)
-#else
- gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
- & wbond*gradbx(j,i)+
- & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
- & wsccor*gsccorx(j,i)
- & +wscloc*gsclocx(j,i)
-#endif
- enddo
- enddo
-#ifdef DEBUG
- write (iout,*) "gloc before adding corr"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
- do i=1,nres-3
- gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
- & +wcorr5*g_corr5_loc(i)
- & +wcorr6*g_corr6_loc(i)
- & +wturn4*gel_loc_turn4(i)
- & +wturn3*gel_loc_turn3(i)
- & +wturn6*gel_loc_turn6(i)
- & +wel_loc*gel_loc_loc(i)
- enddo
-#ifdef DEBUG
- write (iout,*) "gloc after adding corr"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
-#ifdef MPI
- if (nfgtasks.gt.1) then
- do j=1,3
- do i=1,nres
- gradbufc(j,i)=gradc(j,i,icg)
- gradbufx(j,i)=gradx(j,i,icg)
- enddo
- enddo
- do i=1,4*nres
- glocbuf(i)=gloc(i,icg)
- enddo
-#ifdef DEBUG
- write (iout,*) "gloc_sc before reduce"
- do i=1,nres
- do j=1,3
- write (iout,*) i,j,gloc_sc(j,i,icg)
- enddo
- enddo
-#endif
- do i=1,nres
- do j=1,3
- gloc_scbuf(j,i)=gloc_sc(j,i,icg)
- enddo
- enddo
- time00=MPI_Wtime()
- call MPI_Barrier(FG_COMM,IERR)
- time_barrier_g=time_barrier_g+MPI_Wtime()-time00
- time00=MPI_Wtime()
- call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
- & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
-#ifdef DEBUG
- write (iout,*) "gloc_sc after reduce"
- do i=1,nres
- do j=1,3
- write (iout,*) i,j,gloc_sc(j,i,icg)
- enddo
- enddo
-#endif
-#ifdef DEBUG
- write (iout,*) "gloc after reduce"
- do i=1,4*nres
- write (iout,*) i,gloc(i,icg)
- enddo
-#endif
- endif
-#endif
- if (gnorm_check) then
-c
-c Compute the maximum elements of the gradient
-c
- gvdwc_max=0.0d0
- gvdwc_scp_max=0.0d0
- gelc_max=0.0d0
- gvdwpp_max=0.0d0
- gradb_max=0.0d0
- ghpbc_max=0.0d0
- gradcorr_max=0.0d0
- gel_loc_max=0.0d0
- gcorr3_turn_max=0.0d0
- gcorr4_turn_max=0.0d0
- gradcorr5_max=0.0d0
- gradcorr6_max=0.0d0
- gcorr6_turn_max=0.0d0
- gsccorc_max=0.0d0
- gscloc_max=0.0d0
- gvdwx_max=0.0d0
- gradx_scp_max=0.0d0
- ghpbx_max=0.0d0
- gradxorr_max=0.0d0
- gsccorx_max=0.0d0
- gsclocx_max=0.0d0
- do i=1,nct
- gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
- if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
-#ifdef TSCSC
- gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
- if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
-#endif
- gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
- if (gvdwc_scp_norm.gt.gvdwc_scp_max)
- & gvdwc_scp_max=gvdwc_scp_norm
- gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
- if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
- gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
- if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
- gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
- if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
- ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
- if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
- gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
- if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
- gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
- if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
- gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
- & gcorr3_turn(1,i)))
- if (gcorr3_turn_norm.gt.gcorr3_turn_max)
- & gcorr3_turn_max=gcorr3_turn_norm
- gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
- & gcorr4_turn(1,i)))
- if (gcorr4_turn_norm.gt.gcorr4_turn_max)
- & gcorr4_turn_max=gcorr4_turn_norm
- gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
- if (gradcorr5_norm.gt.gradcorr5_max)
- & gradcorr5_max=gradcorr5_norm
- gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
- if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
- gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
- & gcorr6_turn(1,i)))
- if (gcorr6_turn_norm.gt.gcorr6_turn_max)
- & gcorr6_turn_max=gcorr6_turn_norm
- gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
- if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
- gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
- if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
- gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
- if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
-#ifdef TSCSC
- gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
- if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
-#endif
- gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
- if (gradx_scp_norm.gt.gradx_scp_max)
- & gradx_scp_max=gradx_scp_norm
- ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
- if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
- gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
- if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
- gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
- if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
- gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
- if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
- enddo
- if (gradout) then
-#ifdef AIX
- open(istat,file=statname,position="append")
-#else
- open(istat,file=statname,access="append")
-#endif
- write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
- & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
- & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
- & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
- & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
- & gsccorx_max,gsclocx_max
- close(istat)
- if (gvdwc_max.gt.1.0d4) then
- write (iout,*) "gvdwc gvdwx gradb gradbx"
- do i=nnt,nct
- write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
- & gradb(j,i),gradbx(j,i),j=1,3)
- enddo
- call pdbout(0.0d0,'cipiszcze',iout)
- call flush(iout)
- endif
- endif
- endif
-#ifdef DEBUG
- write (iout,*) "gradc gradx gloc"
- do i=1,nres
- write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
- & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
- enddo
-#endif
-#ifdef TIMING
-#ifdef MPI
- time_sumgradient=time_sumgradient+MPI_Wtime()-time01
-#else
- time_sumgradient=time_sumgradient+tcpu()-time01
-#endif
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine rescale_weights(t_bath)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- double precision kfac /2.4d0/
- double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
-c facT=temp0/t_bath
-c facT=2*temp0/(t_bath+temp0)
- if (rescale_mode.eq.0) then
- facT=1.0d0
- facT2=1.0d0
- facT3=1.0d0
- facT4=1.0d0
- facT5=1.0d0
- else if (rescale_mode.eq.1) then
- facT=kfac/(kfac-1.0d0+t_bath/temp0)
- facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
- facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
- facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
- facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
- else if (rescale_mode.eq.2) then
- x=t_bath/temp0
- x2=x*x
- x3=x2*x
- x4=x3*x
- x5=x4*x
- facT=licznik/dlog(dexp(x)+dexp(-x))
- facT2=licznik/dlog(dexp(x2)+dexp(-x2))
- facT3=licznik/dlog(dexp(x3)+dexp(-x3))
- facT4=licznik/dlog(dexp(x4)+dexp(-x4))
- facT5=licznik/dlog(dexp(x5)+dexp(-x5))
- else
- write (iout,*) "Wrong RESCALE_MODE",rescale_mode
- write (*,*) "Wrong RESCALE_MODE",rescale_mode
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERROR)
-#endif
- stop 555
- endif
- welec=weights(3)*fact
- wcorr=weights(4)*fact3
- wcorr5=weights(5)*fact4
- wcorr6=weights(6)*fact5
- wel_loc=weights(7)*fact2
- wturn3=weights(8)*fact2
- wturn4=weights(9)*fact3
- wturn6=weights(10)*fact5
- wtor=weights(13)*fact
- wtor_d=weights(14)*fact2
- wsccor=weights(21)*fact
-#ifdef TSCSC
-c wsct=t_bath/temp0
- wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
-#endif
- return
- end
-C------------------------------------------------------------------------
- subroutine enerprint(energia)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.MD'
- double precision energia(0:n_ene)
- etot=energia(0)
-#ifdef TSCSC
- evdw=energia(22)+wsct*energia(23)
-#else
- evdw=energia(1)
-#endif
- evdw2=energia(2)
-#ifdef SCP14
- evdw2=energia(2)+energia(18)
-#else
- evdw2=energia(2)
-#endif
- ees=energia(3)
-#ifdef SPLITELE
- evdw1=energia(16)
-#endif
- ecorr=energia(4)
- ecorr5=energia(5)
- ecorr6=energia(6)
- eel_loc=energia(7)
- eello_turn3=energia(8)
- eello_turn4=energia(9)
- eello_turn6=energia(10)
- ebe=energia(11)
- escloc=energia(12)
- etors=energia(13)
- etors_d=energia(14)
- ehpb=energia(15)
- edihcnstr=energia(19)
- estr=energia(17)
- Uconst=energia(20)
- esccor=energia(21)
- ehomology_constr=energia(24)
-
-#ifdef SPLITELE
- write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
- & estr,wbond,ebe,wang,
- & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
- & ecorr,wcorr,
- & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
- & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
- & edihcnstr,ehomology_constr, ebr*nss,
- & Uconst,etot
- 10 format (/'Virtual-chain energies:'//
- & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
- & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
- & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
- & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
- & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
- & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
- & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
- & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
- & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
- & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
- & ' (SS bridges & dist. cnstr.)'/
- & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
- & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
- & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
- & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
- & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
- & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
- & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
- & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
- & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
- & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
- & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
- & 'UCONST= ',1pE16.6,' (Constraint energy)'/
- & 'ETOT= ',1pE16.6,' (total)')
-#else
- write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
- & estr,wbond,ebe,wang,
- & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
- & ecorr,wcorr,
- & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
- & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
- & ehomology_constr,ebr*nss,Uconst,etot
- 10 format (/'Virtual-chain energies:'//
- & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
- & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
- & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
- & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
- & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
- & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
- & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
- & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
- & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
- & ' (SS bridges & dist. cnstr.)'/
- & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
- & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
- & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
- & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
- & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
- & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
- & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
- & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/
- & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
- & 'UCONST=',1pE16.6,' (Constraint energy)'/
- & 'ETOT= ',1pE16.6,' (total)')
-#endif
- return
- end
-C-----------------------------------------------------------------------
- subroutine elj(evdw,evdw_p,evdw_m)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C Change 12/1/95
- num_conti=0
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
-cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
-cd & 'iend=',iend(i,iint)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
-C Change 12/1/95 to calculate four-body interactions
- rij=xj*xj+yj*yj+zj*zj
- rrij=1.0D0/rij
-c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
- eps0ij=eps(itypi,itypj)
- fac=rrij**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- evdw_p=evdw_p+evdwij
- else
- evdw_m=evdw_m+evdwij
- endif
-#else
- evdw=evdw+evdwij
-#endif
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-rrij*(e1+evdwij)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0.0d0) then
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- else
- do k=1,3
- gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
- gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
- gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
- gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
- enddo
- endif
-#else
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
-#endif
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
-C
-C 12/1/95, revised on 5/20/97
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-C
-C Uncomment next line, if the correlation interactions include EVDW explicitly.
-c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
-C Uncomment next line, if the correlation interactions are contact function only
- if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
- rij=dsqrt(rij)
- sigij=sigma(itypi,itypj)
- r0ij=rs0(itypi,itypj)
-C
-C Check whether the SC's are not too far to make a contact.
-C
- rcut=1.5d0*r0ij
- call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
-C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
-C
- if (fcont.gt.0.0D0) then
-C If the SC-SC distance if close to sigma, apply spline.
-cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
-cAdam & fcont1,fprimcont1)
-cAdam fcont1=1.0d0-fcont1
-cAdam if (fcont1.gt.0.0d0) then
-cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
-cAdam fcont=fcont*fcont1
-cAdam endif
-C Uncomment following 4 lines to have the geometric average of the epsilon0's
-cga eps0ij=1.0d0/dsqrt(eps0ij)
-cga do k=1,3
-cga gg(k)=gg(k)*eps0ij
-cga enddo
-cga eps0ij=-evdwij*eps0ij
-C Uncomment for AL's type of SC correlation interactions.
-cadam eps0ij=-evdwij
- num_conti=num_conti+1
- jcont(num_conti,i)=j
- facont(num_conti,i)=fcont*eps0ij
- fprimcont=eps0ij*fprimcont/rij
- fcont=expon*fcont
-cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
-cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
-cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
-C Uncomment following 3 lines for Skolnick's type of SC correlation.
- gacont(1,num_conti,i)=-fprimcont*xj
- gacont(2,num_conti,i)=-fprimcont*yj
- gacont(3,num_conti,i)=-fprimcont*zj
-cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
-cd write (iout,'(2i3,3f10.5)')
-cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
- endif
- endif
- enddo ! j
- enddo ! iint
-C Change 12/1/95
- num_cont(i)=num_conti
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time, the factor of EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eljk(evdw,evdw_p,evdw_m)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJK potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- dimension gg(3)
- logical scheck
-c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- r_inv_ij=dsqrt(rrij)
- rij=1.0D0/r_inv_ij
- r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
- fac=r_shift_inv**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=e_augm+e1+e2
-cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
-cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
-cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
-cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- evdw_p=evdw_p+evdwij
- else
- evdw_m=evdw_m+evdwij
- endif
-#else
- evdw=evdw+evdwij
-#endif
-C
-C Calculate the components of the gradient in DC and X
-C
- fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0.0d0) then
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
- else
- do k=1,3
- gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
- gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
- gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
- gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
- enddo
- endif
-#else
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
-#endif
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- enddo ! j
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc(j,i)=expon*gvdwc(j,i)
- gvdwx(j,i)=expon*gvdwx(j,i)
- enddo
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine ebp(evdw,evdw_p,evdw_m)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Berne-Pechukas potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
-c double precision rrsave(maxdim)
- logical lprn
- evdw=0.0D0
-c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
-c if (icall.eq.0) then
-c lprn=.true.
-c else
- lprn=.false.
-c endif
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-cd if (icall.eq.0) then
-cd rrsave(ind)=rrij
-cd else
-cd rrij=rrsave(ind)
-cd endif
- rij=dsqrt(rrij)
-C Calculate the angle-dependent terms of energy & contributions to derivatives.
- call sc_angular
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- fac=(rrij*sigsq)**expon2
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- evdw_p=evdw_p+evdwij
- else
- evdw_m=evdw_m+evdwij
- endif
-#else
- evdw=evdw+evdwij
-#endif
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & epsi,sigm,chi1,chi2,chip1,chip2,
-cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
-cd & om1,om2,om12,1.0D0/dsqrt(rrij),
-cd & evdwij
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)
- sigder=fac/sigsq
- fac=rrij*fac
-C Calculate radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate the angular part of the gradient and sum add the contributions
-C to the appropriate components of the Cartesian gradient.
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- call sc_grad
- else
- call sc_grad_T
- endif
-#else
- call sc_grad
-#endif
- enddo ! j
- enddo ! iint
- enddo ! i
-c stop
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egb(evdw,evdw_p,evdw_m)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- logical lprn
- evdw=0.0D0
-ccccc energy_dec=.false.
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- evdw_p=0.0D0
- evdw_m=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.false.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
- call dyn_ssbond_ene(i,j,evdwij)
- evdw=evdw+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
- & 'evdw',i,j,evdwij,' ss'
- ELSE
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
-c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c & 1.0d0/vbld(j+nres)
-c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
-c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
-c write (iout,*) "j",j," dc_norm",
-c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-c for diagnostics; uncomment
-c rij_shift=1.2*sig0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
-c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
- evdwij=evdwij*eps2rt*eps3rt
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- evdw_p=evdw_p+evdwij
- else
- evdw_m=evdw_m+evdwij
- endif
-#else
- evdw=evdw+evdwij
-#endif
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij
- endif
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
-
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
-c fac=0.0d0
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- call sc_grad
- else
- call sc_grad_T
- endif
-#else
- call sc_grad
-#endif
- ENDIF ! dyn_ss
- enddo ! j
- enddo ! iint
- enddo ! i
-c write (iout,*) "Number of loop steps in EGB:",ind
-cccc energy_dec=.false.
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egbv(evdw,evdw_p,evdw_m)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne-Vorobjev potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- common /srutu/ icall
- logical lprn
- evdw=0.0D0
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(i+nres)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(j+nres)
- sig0ij=sigma(itypi,itypj)
- r0ij=r0(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+r0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- fac_augm=rrij**expon
- e_augm=augm(itypi,itypj)*fac_augm
- evdwij=evdwij*eps2rt*eps3rt
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- evdw_p=evdw_p+evdwij+e_augm
- else
- evdw_m=evdw_m+evdwij+e_augm
- endif
-#else
- evdw=evdw+evdwij+e_augm
-#endif
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
- write (iout,'(2(a3,i3,2x),17(0pf7.3))')
- & restyp(itypi),i,restyp(itypj),j,
- & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
- & chi1,chi2,chip1,chip2,
- & eps1,eps2rt**2,eps3rt**2,
- & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
- & evdwij+e_augm
- endif
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac-2*expon*rrij*e_augm
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
-#ifdef TSCSC
- if (bb(itypi,itypj).gt.0) then
- call sc_grad
- else
- call sc_grad_T
- endif
-#else
- call sc_grad
-#endif
- enddo ! j
- enddo ! iint
- enddo ! i
- end
-C-----------------------------------------------------------------------------
- subroutine sc_angular
-C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
-C om12. Called by ebp, egb, and egbv.
- implicit none
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- erij(1)=xj*rij
- erij(2)=yj*rij
- erij(3)=zj*rij
- om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
- om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
- om12=dxi*dxj+dyi*dyj+dzi*dzj
- chiom12=chi12*om12
-C Calculate eps1(om12) and its derivative in om12
- faceps1=1.0D0-om12*chiom12
- faceps1_inv=1.0D0/faceps1
- eps1=dsqrt(faceps1_inv)
-C Following variable is eps1*deps1/dom12
- eps1_om12=faceps1_inv*chiom12
-c diagnostics only
-c faceps1_inv=om12
-c eps1=om12
-c eps1_om12=1.0d0
-c write (iout,*) "om12",om12," eps1",eps1
-C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
-C and om12.
- om1om2=om1*om2
- chiom1=chi1*om1
- chiom2=chi2*om2
- facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
- sigsq=1.0D0-facsig*faceps1_inv
- sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
- sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
- sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
-c diagnostics only
-c sigsq=1.0d0
-c sigsq_om1=0.0d0
-c sigsq_om2=0.0d0
-c sigsq_om12=0.0d0
-c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
-c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
-c & " eps1",eps1
-C Calculate eps2 and its derivatives in om1, om2, and om12.
- chipom1=chip1*om1
- chipom2=chip2*om2
- chipom12=chip12*om12
- facp=1.0D0-om12*chipom12
- facp_inv=1.0D0/facp
- facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
-c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
-c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
-C Following variable is the square root of eps2
- eps2rt=1.0D0-facp1*facp_inv
-C Following three variables are the derivatives of the square root of eps
-C in om1, om2, and om12.
- eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
- eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
- eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
-C Evaluate the "asymmetric" factor in the VDW constant, eps3
- eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
-c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
-c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
-c & " eps2rt_om12",eps2rt_om12
-C Calculate whole angle-dependent part of epsilon and contributions
-C to its derivatives
- return
- end
-
-C----------------------------------------------------------------------------
- subroutine sc_grad_T
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- double precision dcosom1(3),dcosom2(3)
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
- & -2.0D0*alf12*eps3der+sigder*sigsq_om12
-c diagnostics only
-c eom1=0.0d0
-c eom2=0.0d0
-c eom12=evdwij*eps1_om12
-c end diagnostics
-c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
-c & " sigder",sigder
-c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- do k=1,3
- gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- enddo
-c write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
-c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
-c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- do l=1,3
- gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
- gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
- enddo
- return
- end
-
-C----------------------------------------------------------------------------
- subroutine sc_grad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.CALC'
- include 'COMMON.IOUNITS'
- double precision dcosom1(3),dcosom2(3)
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
- & -2.0D0*alf12*eps3der+sigder*sigsq_om12
-c diagnostics only
-c eom1=0.0d0
-c eom2=0.0d0
-c eom12=evdwij*eps1_om12
-c end diagnostics
-c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
-c & " sigder",sigder
-c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
-c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- do k=1,3
- gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- enddo
-c write (iout,*) "gg",(gg(k),k=1,3)
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
-c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
-c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
-c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
- enddo
- return
- end
-C-----------------------------------------------------------------------
- subroutine e_softsphere(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the LJ potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (accur=1.0d-10)
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.TORSION'
- include 'COMMON.SBRIDGE'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTACTS'
- dimension gg(3)
-cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
- evdw=0.0D0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
-cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
-cd & 'iend=',iend(i,iint)
- do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- rij=xj*xj+yj*yj+zj*zj
-c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
- r0ij=r0(itypi,itypj)
- r0ijsq=r0ij*r0ij
-c print *,i,j,r0ij,dsqrt(rij)
- if (rij.lt.r0ijsq) then
- evdwij=0.25d0*(rij-r0ijsq)**2
- fac=rij-r0ijsq
- else
- evdwij=0.0d0
- fac=0.0d0
- endif
- evdw=evdw+evdwij
-C
-C Calculate the components of the gradient in DC and X
-C
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- gvdwc(k,i)=gvdwc(k,i)-gg(k)
- gvdwc(k,j)=gvdwc(k,j)+gg(k)
- enddo
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- enddo ! j
- enddo ! iint
- enddo ! i
- return
- end
-C--------------------------------------------------------------------------
- subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
- & eello_turn4)
-C
-C Soft-sphere potential of p-p interaction
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- dimension ggg(3)
-cd write(iout,*) 'In EELEC_soft_sphere'
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- ind=0
- do i=iatel_s,iatel_e
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
- do j=ielstart(i),ielend(i)
- ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- r0ij=rpp(iteli,itelj)
- r0ijsq=r0ij*r0ij
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- if (rij.lt.r0ijsq) then
- evdw1ij=0.25d0*(rij-r0ijsq)**2
- fac=rij-r0ijsq
- else
- evdw1ij=0.0d0
- fac=0.0d0
- endif
- evdw1=evdw1+evdw1ij
-C
-C Calculate contributions to the Cartesian gradient.
-C
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
- do k=1,3
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- enddo ! j
- enddo ! i
-cgrad do i=nnt,nct-1
-cgrad do k=1,3
-cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
-cgrad enddo
-cgrad do j=i+1,nct-1
-cgrad do k=1,3
-cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
-cgrad enddo
-cgrad enddo
-cgrad enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine vec_and_deriv
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
- dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
-C Compute the local reference systems. For reference system (i), the
-C X-axis points from CA(i) to CA(i+1), the Y axis is in the
-C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
-#ifdef PARVEC
- do i=ivec_start,ivec_end
-#else
- do i=1,nres-1
-#endif
- if (i.eq.nres-1) then
-C Case of the last full residue
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
- costh=dcos(pi-theta(nres))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i-1)
- uzder(3,1,1)= dc_norm(2,i-1)
- uzder(1,2,1)= dc_norm(3,i-1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i-1)
- uzder(1,3,1)=-dc_norm(2,i-1)
- uzder(2,3,1)= dc_norm(1,i-1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
-C Compute the Y-axis
- facy=fac
- do k=1,3
- uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
- enddo
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i-1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
- uyder(j,j,1)=uyder(j,j,1)-costh
- uyder(j,j,2)=1.0d0+uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- else
-C Other residues
-C Compute the Z-axis
- call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
- costh=dcos(pi-theta(i+2))
- fac=1.0d0/dsqrt(1.0d0-costh*costh)
- do k=1,3
- uz(k,i)=fac*uz(k,i)
- enddo
-C Compute the derivatives of uz
- uzder(1,1,1)= 0.0d0
- uzder(2,1,1)=-dc_norm(3,i+1)
- uzder(3,1,1)= dc_norm(2,i+1)
- uzder(1,2,1)= dc_norm(3,i+1)
- uzder(2,2,1)= 0.0d0
- uzder(3,2,1)=-dc_norm(1,i+1)
- uzder(1,3,1)=-dc_norm(2,i+1)
- uzder(2,3,1)= dc_norm(1,i+1)
- uzder(3,3,1)= 0.0d0
- uzder(1,1,2)= 0.0d0
- uzder(2,1,2)= dc_norm(3,i)
- uzder(3,1,2)=-dc_norm(2,i)
- uzder(1,2,2)=-dc_norm(3,i)
- uzder(2,2,2)= 0.0d0
- uzder(3,2,2)= dc_norm(1,i)
- uzder(1,3,2)= dc_norm(2,i)
- uzder(2,3,2)=-dc_norm(1,i)
- uzder(3,3,2)= 0.0d0
-C Compute the Y-axis
- facy=fac
- do k=1,3
- uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
- enddo
-C Compute the derivatives of uy
- do j=1,3
- do k=1,3
- uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
- & -dc_norm(k,i)*dc_norm(j,i+1)
- uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
- enddo
- uyder(j,j,1)=uyder(j,j,1)-costh
- uyder(j,j,2)=1.0d0+uyder(j,j,2)
- enddo
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=uyder(l,k,j)
- uzgrad(l,k,j,i)=uzder(l,k,j)
- enddo
- enddo
- enddo
- call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
- call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
- call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
- call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
- endif
- enddo
- do i=1,nres-1
- vbld_inv_temp(1)=vbld_inv(i+1)
- if (i.lt.nres-1) then
- vbld_inv_temp(2)=vbld_inv(i+2)
- else
- vbld_inv_temp(2)=vbld_inv(i)
- endif
- do j=1,2
- do k=1,3
- do l=1,3
- uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
- uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
-#if defined(PARVEC) && defined(MPI)
- if (nfgtasks1.gt.1) then
- time00=MPI_Wtime()
-c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
-c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
-c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
- call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
- & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
- & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
- & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
- & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
- call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
- & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
- & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
- time_gather=time_gather+MPI_Wtime()-time00
- endif
-c if (fg_rank.eq.0) then
-c write (iout,*) "Arrays UY and UZ"
-c do i=1,nres-1
-c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
-c & (uz(k,i),k=1,3)
-c enddo
-c endif
-#endif
- return
- end
-C-----------------------------------------------------------------------------
- subroutine check_vecgrad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.VECTORS'
- dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
- dimension uyt(3,maxres),uzt(3,maxres)
- dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
- double precision delta /1.0d-7/
- call vec_and_deriv
-cd do i=1,nres
-crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
-crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
-cd & (dc_norm(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
-cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
-cd write(iout,'(a)')
-cd enddo
- do i=1,nres
- do j=1,2
- do k=1,3
- do l=1,3
- uygradt(l,k,j,i)=uygrad(l,k,j,i)
- uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
- enddo
- enddo
- enddo
- enddo
- call vec_and_deriv
- do i=1,nres
- do j=1,3
- uyt(j,i)=uy(j,i)
- uzt(j,i)=uz(j,i)
- enddo
- enddo
- do i=1,nres
-cd write (iout,*) 'i=',i
- do k=1,3
- erij(k)=dc_norm(k,i)
- enddo
- do j=1,3
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
- dc_norm(j,i)=dc_norm(j,i)+delta
-c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
-c do k=1,3
-c dc_norm(k,i)=dc_norm(k,i)/fac
-c enddo
-c write (iout,*) (dc_norm(k,i),k=1,3)
-c write (iout,*) (erij(k),k=1,3)
- call vec_and_deriv
- do k=1,3
- uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
- uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
- uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
- uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
- enddo
-c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
-c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
- enddo
- do k=1,3
- dc_norm(k,i)=erij(k)
- enddo
-cd do k=1,3
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
-cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
-cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
-cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
-cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
-cd write (iout,'(a)')
-cd enddo
- enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine set_matrices
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
- include "COMMON.SETUP"
- integer IERR
- integer status(MPI_STATUS_SIZE)
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- double precision auxvec(2),auxmat(2,2)
-C
-C Compute the virtual-bond-torsional-angle dependent quantities needed
-C to calculate the el-loc multibody terms of various order.
-C
-#ifdef PARMAT
- do i=ivec_start+2,ivec_end+2
-#else
- do i=3,nres+1
-#endif
- if (i .lt. nres+1) then
- sin1=dsin(phi(i))
- cos1=dcos(phi(i))
- sintab(i-2)=sin1
- costab(i-2)=cos1
- obrot(1,i-2)=cos1
- obrot(2,i-2)=sin1
- sin2=dsin(2*phi(i))
- cos2=dcos(2*phi(i))
- sintab2(i-2)=sin2
- costab2(i-2)=cos2
- obrot2(1,i-2)=cos2
- obrot2(2,i-2)=sin2
- Ug(1,1,i-2)=-cos1
- Ug(1,2,i-2)=-sin1
- Ug(2,1,i-2)=-sin1
- Ug(2,2,i-2)= cos1
- Ug2(1,1,i-2)=-cos2
- Ug2(1,2,i-2)=-sin2
- Ug2(2,1,i-2)=-sin2
- Ug2(2,2,i-2)= cos2
- else
- costab(i-2)=1.0d0
- sintab(i-2)=0.0d0
- obrot(1,i-2)=1.0d0
- obrot(2,i-2)=0.0d0
- obrot2(1,i-2)=0.0d0
- obrot2(2,i-2)=0.0d0
- Ug(1,1,i-2)=1.0d0
- Ug(1,2,i-2)=0.0d0
- Ug(2,1,i-2)=0.0d0
- Ug(2,2,i-2)=1.0d0
- Ug2(1,1,i-2)=0.0d0
- Ug2(1,2,i-2)=0.0d0
- Ug2(2,1,i-2)=0.0d0
- Ug2(2,2,i-2)=0.0d0
- endif
- if (i .gt. 3 .and. i .lt. nres+1) then
- obrot_der(1,i-2)=-sin1
- obrot_der(2,i-2)= cos1
- Ugder(1,1,i-2)= sin1
- Ugder(1,2,i-2)=-cos1
- Ugder(2,1,i-2)=-cos1
- Ugder(2,2,i-2)=-sin1
- dwacos2=cos2+cos2
- dwasin2=sin2+sin2
- obrot2_der(1,i-2)=-dwasin2
- obrot2_der(2,i-2)= dwacos2
- Ug2der(1,1,i-2)= dwasin2
- Ug2der(1,2,i-2)=-dwacos2
- Ug2der(2,1,i-2)=-dwacos2
- Ug2der(2,2,i-2)=-dwasin2
- else
- obrot_der(1,i-2)=0.0d0
- obrot_der(2,i-2)=0.0d0
- Ugder(1,1,i-2)=0.0d0
- Ugder(1,2,i-2)=0.0d0
- Ugder(2,1,i-2)=0.0d0
- Ugder(2,2,i-2)=0.0d0
- obrot2_der(1,i-2)=0.0d0
- obrot2_der(2,i-2)=0.0d0
- Ug2der(1,1,i-2)=0.0d0
- Ug2der(1,2,i-2)=0.0d0
- Ug2der(2,1,i-2)=0.0d0
- Ug2der(2,2,i-2)=0.0d0
- endif
-c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
- if (i.gt. nnt+2 .and. i.lt.nct+2) then
- iti = itortyp(itype(i-2))
- else
- iti=ntortyp+1
- endif
-c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
- if (i.gt. nnt+1 .and. i.lt.nct+1) then
- iti1 = itortyp(itype(i-1))
- else
- iti1=ntortyp+1
- endif
-cd write (iout,*) '*******i',i,' iti1',iti
-cd write (iout,*) 'b1',b1(:,iti)
-cd write (iout,*) 'b2',b2(:,iti)
-cd write (iout,*) 'Ug',Ug(:,:,i-2)
-c if (i .gt. iatel_s+2) then
- if (i .gt. nnt+2) then
- call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
- call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
- & then
- call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
- call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
- endif
- else
- do k=1,2
- Ub2(k,i-2)=0.0d0
- Ctobr(k,i-2)=0.0d0
- Dtobr2(k,i-2)=0.0d0
- do l=1,2
- EUg(l,k,i-2)=0.0d0
- CUg(l,k,i-2)=0.0d0
- DUg(l,k,i-2)=0.0d0
- DtUg2(l,k,i-2)=0.0d0
- enddo
- enddo
- endif
- call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
- call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
- do k=1,2
- muder(k,i-2)=Ub2der(k,i-2)
- enddo
-c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
- if (i.gt. nnt+1 .and. i.lt.nct+1) then
- iti1 = itortyp(itype(i-1))
- else
- iti1=ntortyp+1
- endif
- do k=1,2
- mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
- enddo
-cd write (iout,*) 'mu ',mu(:,i-2)
-cd write (iout,*) 'mu1',mu1(:,i-2)
-cd write (iout,*) 'mu2',mu2(:,i-2)
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
- & then
- call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
- call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
- call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
- call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
- call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
-C Vectors and matrices dependent on a single virtual-bond dihedral.
- call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
- call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
- call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
- call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
- call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
- call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
- call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
- call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
- endif
- enddo
-C Matrices dependent on two consecutive virtual-bond dihedrals.
-C The order of matrices is from left to right.
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
- &then
-c do i=max0(ivec_start,2),ivec_end
- do i=2,nres-1
- call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
- call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
- call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
- call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
- call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
- call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
- call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
- call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
- enddo
- endif
-#if defined(MPI) && defined(PARMAT)
-#ifdef DEBUG
-c if (fg_rank.eq.0) then
- write (iout,*) "Arrays UG and UGDER before GATHER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug(l,k,i),l=1,2),k=1,2),
- & ((ugder(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays UG2 and UG2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug2(l,k,i),l=1,2),k=1,2),
- & ((ug2der(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
- & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
- enddo
- write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & costab(i),sintab(i),costab2(i),sintab2(i)
- enddo
- write (iout,*) "Array MUDER"
- do i=1,nres-1
- write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
- enddo
-c endif
-#endif
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
-c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
-c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
-#ifdef MATGATHER
- call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
- & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
- & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
- & then
- call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
- & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
- & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
- & FG_COMM1,IERR)
- call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
- & MPI_MAT2,FG_COMM1,IERR)
- call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
- & ivec_count(fg_rank1),
- & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
- & MPI_MAT2,FG_COMM1,IERR)
- endif
-#else
-c Passes matrix info through the ring
- isend=fg_rank1
- irecv=fg_rank1-1
- if (irecv.lt.0) irecv=nfgtasks1-1
- iprev=irecv
- inext=fg_rank1+1
- if (inext.ge.nfgtasks1) inext=0
- do i=1,nfgtasks1-1
-c write (iout,*) "isend",isend," irecv",irecv
-c call flush(iout)
- lensend=lentyp(isend)
- lenrecv=lentyp(irecv)
-c write (iout,*) "lensend",lensend," lenrecv",lenrecv
-c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
-c & MPI_ROTAT1(lensend),inext,2200+isend,
-c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
-c & iprev,2200+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather ROTAT1"
-c call flush(iout)
-c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
-c & MPI_ROTAT2(lensend),inext,3300+isend,
-c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
-c & iprev,3300+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather ROTAT2"
-c call flush(iout)
- call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
- & MPI_ROTAT_OLD(lensend),inext,4400+isend,
- & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
- & iprev,4400+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather ROTAT_OLD"
-c call flush(iout)
- call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP11(lensend),inext,5500+isend,
- & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
- & iprev,5500+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP11"
-c call flush(iout)
- call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP12(lensend),inext,6600+isend,
- & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
- & iprev,6600+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP12"
-c call flush(iout)
- if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
- & then
- call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
- & MPI_ROTAT2(lensend),inext,7700+isend,
- & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
- & iprev,7700+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP21"
-c call flush(iout)
- call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP22(lensend),inext,8800+isend,
- & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
- & iprev,8800+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP22"
-c call flush(iout)
- call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
- & MPI_PRECOMP23(lensend),inext,9900+isend,
- & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
- & MPI_PRECOMP23(lenrecv),
- & iprev,9900+irecv,FG_COMM,status,IERR)
-c write (iout,*) "Gather PRECOMP23"
-c call flush(iout)
- endif
- isend=irecv
- irecv=irecv-1
- if (irecv.lt.0) irecv=nfgtasks1-1
- enddo
-#endif
- time_gather=time_gather+MPI_Wtime()-time00
- endif
-#ifdef DEBUG
-c if (fg_rank.eq.0) then
- write (iout,*) "Arrays UG and UGDER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug(l,k,i),l=1,2),k=1,2),
- & ((ugder(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays UG2 and UG2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & ((ug2(l,k,i),l=1,2),k=1,2),
- & ((ug2der(l,k,i),l=1,2),k=1,2)
- enddo
- write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
- & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
- enddo
- write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
- do i=1,nres-1
- write (iout,'(i5,4f10.5,5x,4f10.5)') i,
- & costab(i),sintab(i),costab2(i),sintab2(i)
- enddo
- write (iout,*) "Array MUDER"
- do i=1,nres-1
- write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
- enddo
-c endif
-#endif
-#endif
-cd do i=1,nres
-cd iti = itortyp(itype(i))
-cd write (iout,*) i
-cd do j=1,2
-cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
-cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
-cd enddo
-cd enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
-C
-C This subroutine calculates the average interaction energy and its gradient
-C in the virtual-bond vectors between non-adjacent peptide groups, based on
-C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
-C The potential depends both on the distance of peptide-group centers and on
-C the orientation of the CA-CA virtual bonds.
-C
- implicit real*8 (a-h,o-z)
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-cd write(iout,*) 'In EELEC'
-cd do i=1,nloctyp
-cd write(iout,*) 'Type',i
-cd write(iout,*) 'B1',B1(:,i)
-cd write(iout,*) 'B2',B2(:,i)
-cd write(iout,*) 'CC',CC(:,:,i)
-cd write(iout,*) 'DD',DD(:,:,i)
-cd write(iout,*) 'EE',EE(:,:,i)
-cd enddo
-cd call check_vecgrad
-cd stop
- if (icheckgrad.eq.1) then
- do i=1,nres-1
- fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
- do k=1,3
- dc_norm(k,i)=dc(k,i)*fac
- enddo
-c write (iout,*) 'i',i,' fac',fac
- enddo
- endif
- if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
- & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
-c call vec_and_deriv
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call set_matrices
-#ifdef TIMING
- time_mat=time_mat+MPI_Wtime()-time01
-#endif
- endif
-cd do i=1,nres-1
-cd write (iout,*) 'i=',i
-cd do k=1,3
-cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
-cd enddo
-cd do k=1,3
-cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
-cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
-cd enddo
-cd enddo
- t_eelecij=0.0d0
- ees=0.0D0
- evdw1=0.0D0
- eel_loc=0.0d0
- eello_turn3=0.0d0
- eello_turn4=0.0d0
- ind=0
- do i=1,nres
- num_cont_hb(i)=0
- enddo
-cd print '(a)','Enter EELEC'
-cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- enddo
-c
-c
-c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
-C
-C Loop over i,i+2 and i,i+3 pairs of the peptide groups
-C
- do i=iturn3_start,iturn3_end
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=0
- call eelecij(i,i+2,ees,evdw1,eel_loc)
- if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
- num_cont_hb(i)=num_conti
- enddo
- do i=iturn4_start,iturn4_end
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
- num_conti=num_cont_hb(i)
- call eelecij(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
- num_cont_hb(i)=num_conti
- enddo ! i
-c
-c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
-c
- do i=iatel_s,iatel_e
- dxi=dc(1,i)
- dyi=dc(2,i)
- dzi=dc(3,i)
- dx_normi=dc_norm(1,i)
- dy_normi=dc_norm(2,i)
- dz_normi=dc_norm(3,i)
- xmedi=c(1,i)+0.5d0*dxi
- ymedi=c(2,i)+0.5d0*dyi
- zmedi=c(3,i)+0.5d0*dzi
-c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
- num_conti=num_cont_hb(i)
- do j=ielstart(i),ielend(i)
- call eelecij(i,j,ees,evdw1,eel_loc)
- enddo ! j
- num_cont_hb(i)=num_conti
- enddo ! i
-c write (iout,*) "Number of loop steps in EELEC:",ind
-cd do i=1,nres
-cd write (iout,'(i3,3f10.5,5x,3f10.5)')
-cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
-cd enddo
-c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
-ccc eel_loc=eel_loc+eello_turn3
-cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
- return
- end
-C-------------------------------------------------------------------------------
- subroutine eelecij(i,j,ees,evdw1,eel_loc)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.TIME1'
- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
- & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
- double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
-c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
-#ifdef MOMENT
- double precision scal_el /1.0d0/
-#else
- double precision scal_el /0.5d0/
-#endif
-C 12/13/98
-C 13-go grudnia roku pamietnego...
- double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
- & 0.0d0,1.0d0,0.0d0,
- & 0.0d0,0.0d0,1.0d0/
-c time00=MPI_Wtime()
-cd write (iout,*) "eelecij",i,j
-c ind=ind+1
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- aaa=app(iteli,itelj)
- bbb=bpp(iteli,itelj)
- ael6i=ael6(iteli,itelj)
- ael3i=ael3(iteli,itelj)
- dxj=dc(1,j)
- dyj=dc(2,j)
- dzj=dc(3,j)
- dx_normj=dc_norm(1,j)
- dy_normj=dc_norm(2,j)
- dz_normj=dc_norm(3,j)
- xj=c(1,j)+0.5D0*dxj-xmedi
- yj=c(2,j)+0.5D0*dyj-ymedi
- zj=c(3,j)+0.5D0*dzj-zmedi
- rij=xj*xj+yj*yj+zj*zj
- rrmij=1.0D0/rij
- rij=dsqrt(rij)
- rmij=1.0D0/rij
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
- cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
- cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
- fac=cosa-3.0D0*cosb*cosg
- ev1=aaa*r6ij*r6ij
-c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
- if (j.eq.i+2) ev1=scal_el*ev1
- ev2=bbb*r6ij
- fac3=ael6i*r6ij
- fac4=ael3i*r3ij
- evdwij=ev1+ev2
- el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- eesij=el1+el2
-C 12/26/95 - for the evaluation of multi-body H-bonding interactions
- ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
- ees=ees+eesij
- evdw1=evdw1+evdwij
-cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
-cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
-cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
-cd & xmedi,ymedi,zmedi,xj,yj,zj
-
- if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
- write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
- endif
-
-C
-C Calculate contributions to the Cartesian gradient.
-C
-#ifdef SPLITELE
- facvdw=-6*rrmij*(ev1+evdwij)
- facel=-3*rrmij*(el1+eesij)
- fac1=fac
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=facel*xj
- ggg(2)=facel*yj
- ggg(3)=facel*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
-c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-#else
- facvdw=ev1+evdwij
- facel=el1+eesij
- fac1=fac
- fac=-3*rrmij*(facvdw+facvdw+facel)
- erij(1)=xj*rmij
- erij(2)=yj*rmij
- erij(3)=zj*rmij
-*
-* Radial derivatives. First process both termini of the fragment (i,j)
-*
- ggg(1)=fac*xj
- ggg(2)=fac*yj
- ggg(3)=fac*zj
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c gelc(k,j)=gelc(k,j)+ghalf
-c enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- do k=1,3
- gelc_long(k,j)=gelc(k,j)+ggg(k)
- gelc_long(k,i)=gelc(k,i)-ggg(k)
- enddo
-*
-* Loop over residues i+1 thru j-1.
-*
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-c 9/28/08 AL Gradient compotents will be summed only at the end
- ggg(1)=facvdw*xj
- ggg(2)=facvdw*yj
- ggg(3)=facvdw*zj
- do k=1,3
- gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
- gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
- enddo
-#endif
-*
-* Angular part
-*
- ecosa=2.0D0*fac3*fac1+fac4
- fac4=-3.0D0*fac4
- fac3=-6.0D0*fac3
- ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
- ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
-cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
-cd & (dcosg(k),k=1,3)
- do k=1,3
- ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
- enddo
-c do k=1,3
-c ghalf=0.5D0*ggg(k)
-c gelc(k,i)=gelc(k,i)+ghalf
-c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
-c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
-c gelc(k,j)=gelc(k,j)+ghalf
-c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
-c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
-c enddo
-cgrad do k=i+1,j-1
-cgrad do l=1,3
-cgrad gelc(l,k)=gelc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
- do k=1,3
- gelc(k,i)=gelc(k,i)
- & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gelc(k,j)=gelc(k,j)
- & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gelc_long(k,j)=gelc_long(k,j)+ggg(k)
- gelc_long(k,i)=gelc_long(k,i)-ggg(k)
- enddo
- IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
- & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
- & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C
-C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
-C energy of a peptide unit is assumed in the form of a second-order
-C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
-C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
-C are computed for EVERY pair of non-contiguous peptide groups.
-C
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- kkk=0
- do k=1,2
- do l=1,2
- kkk=kkk+1
- muij(kkk)=mu(k,i)*mu(l,j)
- enddo
- enddo
-cd write (iout,*) 'EELEC: i',i,' j',j
-cd write (iout,*) 'j',j,' j1',j1,' j2',j2
-cd write(iout,*) 'muij',muij
- ury=scalar(uy(1,i),erij)
- urz=scalar(uz(1,i),erij)
- vry=scalar(uy(1,j),erij)
- vrz=scalar(uz(1,j),erij)
- a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
- a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
- a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
- a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
- fac=dsqrt(-ael6i)*r3ij
- a22=a22*fac
- a23=a23*fac
- a32=a32*fac
- a33=a33*fac
-cd write (iout,'(4i5,4f10.5)')
-cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
-cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
-cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
-cd & uy(:,j),uz(:,j)
-cd write (iout,'(4f10.5)')
-cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
-cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
-cd write (iout,'(4f10.5)') ury,urz,vry,vrz
-cd write (iout,'(9f10.5/)')
-cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
-C Derivatives of the elements of A in virtual-bond vectors
- call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
- do k=1,3
- uryg(k,1)=scalar(erder(1,k),uy(1,i))
- uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
- uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
- urzg(k,1)=scalar(erder(1,k),uz(1,i))
- urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
- urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
- vryg(k,1)=scalar(erder(1,k),uy(1,j))
- vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
- vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
- vrzg(k,1)=scalar(erder(1,k),uz(1,j))
- vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
- vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
- enddo
-C Compute radial contributions to the gradient
- facr=-3.0d0*rrmij
- a22der=a22*facr
- a23der=a23*facr
- a32der=a32*facr
- a33der=a33*facr
- agg(1,1)=a22der*xj
- agg(2,1)=a22der*yj
- agg(3,1)=a22der*zj
- agg(1,2)=a23der*xj
- agg(2,2)=a23der*yj
- agg(3,2)=a23der*zj
- agg(1,3)=a32der*xj
- agg(2,3)=a32der*yj
- agg(3,3)=a32der*zj
- agg(1,4)=a33der*xj
- agg(2,4)=a33der*yj
- agg(3,4)=a33der*zj
-C Add the contributions coming from er
- fac3=-3.0d0*fac
- do k=1,3
- agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
- agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
- agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
- agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
- enddo
- do k=1,3
-C Derivatives in DC(i)
-cgrad ghalf1=0.5d0*agg(k,1)
-cgrad ghalf2=0.5d0*agg(k,2)
-cgrad ghalf3=0.5d0*agg(k,3)
-cgrad ghalf4=0.5d0*agg(k,4)
- aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
- & -3.0d0*uryg(k,2)*vry)!+ghalf1
- aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
- & -3.0d0*uryg(k,2)*vrz)!+ghalf2
- aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
- & -3.0d0*urzg(k,2)*vry)!+ghalf3
- aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
- & -3.0d0*urzg(k,2)*vrz)!+ghalf4
-C Derivatives in DC(i+1)
- aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
- & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
- aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
- & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
- aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
- & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
- aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
- & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
-C Derivatives in DC(j)
- aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
- & -3.0d0*vryg(k,2)*ury)!+ghalf1
- aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
- & -3.0d0*vrzg(k,2)*ury)!+ghalf2
- aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
- & -3.0d0*vryg(k,2)*urz)!+ghalf3
- aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
- & -3.0d0*vrzg(k,2)*urz)!+ghalf4
-C Derivatives in DC(j+1) or DC(nres-1)
- aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
- & -3.0d0*vryg(k,3)*ury)
- aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
- & -3.0d0*vrzg(k,3)*ury)
- aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
- & -3.0d0*vryg(k,3)*urz)
- aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
- & -3.0d0*vrzg(k,3)*urz)
-cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
-cgrad do l=1,4
-cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
-cgrad enddo
-cgrad endif
- enddo
- acipa(1,1)=a22
- acipa(1,2)=a23
- acipa(2,1)=a32
- acipa(2,2)=a33
- a22=-a22
- a23=-a23
- do l=1,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- if (j.lt.nres-1) then
- a22=-a22
- a32=-a32
- do l=1,3,2
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- else
- a22=-a22
- a23=-a23
- a32=-a32
- a33=-a33
- do l=1,4
- do k=1,3
- agg(k,l)=-agg(k,l)
- aggi(k,l)=-aggi(k,l)
- aggi1(k,l)=-aggi1(k,l)
- aggj(k,l)=-aggj(k,l)
- aggj1(k,l)=-aggj1(k,l)
- enddo
- enddo
- endif
- ENDIF ! WCORR
- IF (wel_loc.gt.0.0d0) THEN
-C Contribution to the local-electrostatic energy coming from the i-j pair
- eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
- & +a33*muij(4)
-cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eelloc',i,j,eel_loc_ij
-
- eel_loc=eel_loc+eel_loc_ij
-C Partial derivatives in virtual-bond dihedral angles gamma
- if (i.gt.1)
- & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
- & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
- & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
- gel_loc_loc(j-1)=gel_loc_loc(j-1)+
- & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
- & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
-C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
- do l=1,3
- ggg(l)=agg(l,1)*muij(1)+
- & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
- gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
- gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
-cgrad ghalf=0.5d0*ggg(l)
-cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
-cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
- enddo
-cgrad do k=i+1,j2
-cgrad do l=1,3
-cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
-cgrad enddo
-cgrad enddo
-C Remaining derivatives of eello
- do l=1,3
- gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
- & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
- gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
- & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
- gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
- & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
- gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
- & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
- enddo
- ENDIF
-C Change 12/26/95 to calculate four-body contributions to H-bonding energy
-c if (j.gt.i+1 .and. num_conti.le.maxconts) then
- if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
- & .and. num_conti.le.maxconts) then
-c write (iout,*) i,j," entered corr"
-C
-C Calculate the contact function. The ith column of the array JCONT will
-C contain the numbers of atoms that make contacts with the atom I (of numbers
-C greater than I). The arrays FACONT and GACONT will contain the values of
-C the contact function and its derivative.
-c r0ij=1.02D0*rpp(iteli,itelj)
-c r0ij=1.11D0*rpp(iteli,itelj)
- r0ij=2.20D0*rpp(iteli,itelj)
-c r0ij=1.55D0*rpp(iteli,itelj)
- call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
- if (fcont.gt.0.0D0) then
- num_conti=num_conti+1
- if (num_conti.gt.maxconts) then
- write (iout,*) 'WARNING - max. # of contacts exceeded;',
- & ' will skip next contacts for this conf.'
- else
- jcont_hb(num_conti,i)=j
-cd write (iout,*) "i",i," j",j," num_conti",num_conti,
-cd & " jcont_hb",jcont_hb(num_conti,i)
- IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
- & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
-C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
-C terms.
- d_cont(num_conti,i)=rij
-cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
-C --- Electrostatic-interaction matrix ---
- a_chuj(1,1,num_conti,i)=a22
- a_chuj(1,2,num_conti,i)=a23
- a_chuj(2,1,num_conti,i)=a32
- a_chuj(2,2,num_conti,i)=a33
-C --- Gradient of rij
- do kkk=1,3
- grij_hb_cont(kkk,num_conti,i)=erij(kkk)
- enddo
- kkll=0
- do k=1,2
- do l=1,2
- kkll=kkll+1
- do m=1,3
- a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
- a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
- a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
- a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
- a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
- enddo
- enddo
- enddo
- ENDIF
- IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
-C Calculate contact energies
- cosa4=4.0D0*cosa
- wij=cosa-3.0D0*cosb*cosg
- cosbg1=cosb+cosg
- cosbg2=cosb-cosg
-c fac3=dsqrt(-ael6i)/r0ij**3
- fac3=dsqrt(-ael6i)*r3ij
-c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
- ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
- if (ees0tmp.gt.0) then
- ees0pij=dsqrt(ees0tmp)
- else
- ees0pij=0
- endif
-c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
- ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
- if (ees0tmp.gt.0) then
- ees0mij=dsqrt(ees0tmp)
- else
- ees0mij=0
- endif
-c ees0mij=0.0D0
- ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
- ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
-C Diagnostics. Comment out or remove after debugging!
-c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
-c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
-c ees0m(num_conti,i)=0.0D0
-C End diagnostics.
-c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
-c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
-C Angular derivatives of the contact function
- ees0pij1=fac3/ees0pij
- ees0mij1=fac3/ees0mij
- fac3p=-3.0D0*fac3*rrmij
- ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
- ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
-c ees0mij1=0.0D0
- ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
- ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
- ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
- ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
- ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
- ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
- ecosap=ecosa1+ecosa2
- ecosbp=ecosb1+ecosb2
- ecosgp=ecosg1+ecosg2
- ecosam=ecosa1-ecosa2
- ecosbm=ecosb1-ecosb2
- ecosgm=ecosg1-ecosg2
-C Diagnostics
-c ecosap=ecosa1
-c ecosbp=ecosb1
-c ecosgp=ecosg1
-c ecosam=0.0D0
-c ecosbm=0.0D0
-c ecosgm=0.0D0
-C End diagnostics
- facont_hb(num_conti,i)=fcont
- fprimcont=fprimcont/rij
-cd facont_hb(num_conti,i)=1.0D0
-C Following line is for diagnostics.
-cd fprimcont=0.0D0
- do k=1,3
- dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
- dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
- enddo
- do k=1,3
- gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
- gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
- enddo
- gggp(1)=gggp(1)+ees0pijp*xj
- gggp(2)=gggp(2)+ees0pijp*yj
- gggp(3)=gggp(3)+ees0pijp*zj
- gggm(1)=gggm(1)+ees0mijp*xj
- gggm(2)=gggm(2)+ees0mijp*yj
- gggm(3)=gggm(3)+ees0mijp*zj
-C Derivatives due to the contact function
- gacont_hbr(1,num_conti,i)=fprimcont*xj
- gacont_hbr(2,num_conti,i)=fprimcont*yj
- gacont_hbr(3,num_conti,i)=fprimcont*zj
- do k=1,3
-c
-c 10/24/08 cgrad and ! comments indicate the parts of the code removed
-c following the change of gradient-summation algorithm.
-c
-cgrad ghalfp=0.5D0*gggp(k)
-cgrad ghalfm=0.5D0*gggm(k)
- gacontp_hb1(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontp_hb2(k,num_conti,i)=!ghalfp
- & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontp_hb3(k,num_conti,i)=gggp(k)
- gacontm_hb1(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
- & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
- gacontm_hb2(k,num_conti,i)=!ghalfm
- & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
- & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
- gacontm_hb3(k,num_conti,i)=gggm(k)
- enddo
-C Diagnostics. Comment out or remove after debugging!
-cdiag do k=1,3
-cdiag gacontp_hb1(k,num_conti,i)=0.0D0
-cdiag gacontp_hb2(k,num_conti,i)=0.0D0
-cdiag gacontp_hb3(k,num_conti,i)=0.0D0
-cdiag gacontm_hb1(k,num_conti,i)=0.0D0
-cdiag gacontm_hb2(k,num_conti,i)=0.0D0
-cdiag gacontm_hb3(k,num_conti,i)=0.0D0
-cdiag enddo
- ENDIF ! wcorr
- endif ! num_conti.le.maxconts
- endif ! fcont.gt.0
- endif ! j.gt.i+1
- if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
- do k=1,4
- do l=1,3
- ghalf=0.5d0*agg(l,k)
- aggi(l,k)=aggi(l,k)+ghalf
- aggi1(l,k)=aggi1(l,k)+agg(l,k)
- aggj(l,k)=aggj(l,k)+ghalf
- enddo
- enddo
- if (j.eq.nres-1 .and. i.lt.j-2) then
- do k=1,4
- do l=1,3
- aggj1(l,k)=aggj1(l,k)+agg(l,k)
- enddo
- enddo
- endif
- endif
-c t_eelecij=t_eelecij+MPI_Wtime()-time00
- return
- end
-C-----------------------------------------------------------------------------
- subroutine eturn3(i,eello_turn3)
-C Third- and fourth-order contributions from turns
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
- & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
- & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
- double precision agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
- j=i+2
-c write (iout,*) "eturn3",i,j,j1,j2
- a_temp(1,1)=a22
- a_temp(1,2)=a23
- a_temp(2,1)=a32
- a_temp(2,2)=a33
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Third-order contributions
-C
-C (i+2)o----(i+3)
-C | |
-C | |
-C (i+1)o----i
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd call checkint_turn3(i,a_temp,eello_turn3_num)
- call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
- call transpose2(auxmat(1,1),auxmat1(1,1))
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
-cd write (2,*) 'i,',i,' j',j,'eello_turn3',
-cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
-cd & ' eello_turn3_num',4*eello_turn3_num
-C Derivatives in gamma(i)
- call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
- call transpose2(auxmat2(1,1),auxmat3(1,1))
- call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
- gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
-C Derivatives in gamma(i+1)
- call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
- call transpose2(auxmat2(1,1),auxmat3(1,1))
- call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
- gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
-C Cartesian derivatives
- do l=1,3
-c ghalf1=0.5d0*agg(l,1)
-c ghalf2=0.5d0*agg(l,2)
-c ghalf3=0.5d0*agg(l,3)
-c ghalf4=0.5d0*agg(l,4)
- a_temp(1,1)=aggi(l,1)!+ghalf1
- a_temp(1,2)=aggi(l,2)!+ghalf2
- a_temp(2,1)=aggi(l,3)!+ghalf3
- a_temp(2,2)=aggi(l,4)!+ghalf4
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,i)=gcorr3_turn(l,i)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- a_temp(1,1)=aggi1(l,1)!+agg(l,1)
- a_temp(1,2)=aggi1(l,2)!+agg(l,2)
- a_temp(2,1)=aggi1(l,3)!+agg(l,3)
- a_temp(2,2)=aggi1(l,4)!+agg(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- a_temp(1,1)=aggj(l,1)!+ghalf1
- a_temp(1,2)=aggj(l,2)!+ghalf2
- a_temp(2,1)=aggj(l,3)!+ghalf3
- a_temp(2,2)=aggj(l,4)!+ghalf4
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,j)=gcorr3_turn(l,j)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- a_temp(1,1)=aggj1(l,1)
- a_temp(1,2)=aggj1(l,2)
- a_temp(2,1)=aggj1(l,3)
- a_temp(2,2)=aggj1(l,4)
- call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
- gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
- & +0.5d0*(pizda(1,1)+pizda(2,2))
- enddo
- return
- end
-C-------------------------------------------------------------------------------
- subroutine eturn4(i,eello_turn4)
-C Third- and fourth-order contributions from turns
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VECTORS'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
- & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
- & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
- double precision agg(3,4),aggi(3,4),aggi1(3,4),
- & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
- common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
- & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
- & num_conti,j1,j2
- j=i+3
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Fourth-order contributions
-C
-C (i+3)o----(i+4)
-C / |
-C (i+2)o |
-C \ |
-C (i+1)o----i
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd call checkint_turn4(i,a_temp,eello_turn4_num)
-c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
- a_temp(1,1)=a22
- a_temp(1,2)=a23
- a_temp(2,1)=a32
- a_temp(2,2)=a33
- iti1=itortyp(itype(i+1))
- iti2=itortyp(itype(i+2))
- iti3=itortyp(itype(i+3))
-c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
- call transpose2(EUg(1,1,i+1),e1t(1,1))
- call transpose2(Eug(1,1,i+2),e2t(1,1))
- call transpose2(Eug(1,1,i+3),e3t(1,1))
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- eello_turn4=eello_turn4-(s1+s2+s3)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'eturn4',i,j,-(s1+s2+s3)
-cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
-cd & ' eello_turn4_num',8*eello_turn4_num
-C Derivatives in gamma(i)
- call transpose2(EUgder(1,1,i+1),e1tder(1,1))
- call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
-C Derivatives in gamma(i+1)
- call transpose2(EUgder(1,1,i+2),e2tder(1,1))
- call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
- call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
-C Derivatives in gamma(i+2)
- call transpose2(EUgder(1,1,i+3),e3tder(1,1))
- call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
- call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
-C Cartesian derivatives
-C Derivatives of this turn contributions in DC(i+2)
- if (j.lt.nres-1) then
- do l=1,3
- a_temp(1,1)=agg(l,1)
- a_temp(1,2)=agg(l,2)
- a_temp(2,1)=agg(l,3)
- a_temp(2,2)=agg(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- ggg(l)=-(s1+s2+s3)
- gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
- enddo
- endif
-C Remaining derivatives of this turn contribution
- do l=1,3
- a_temp(1,1)=aggi(l,1)
- a_temp(1,2)=aggi(l,2)
- a_temp(2,1)=aggi(l,3)
- a_temp(2,2)=aggi(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
- a_temp(1,1)=aggi1(l,1)
- a_temp(1,2)=aggi1(l,2)
- a_temp(2,1)=aggi1(l,3)
- a_temp(2,2)=aggi1(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
- a_temp(1,1)=aggj(l,1)
- a_temp(1,2)=aggj(l,2)
- a_temp(2,1)=aggj(l,3)
- a_temp(2,2)=aggj(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
- gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
- a_temp(1,1)=aggj1(l,1)
- a_temp(1,2)=aggj1(l,2)
- a_temp(2,1)=aggj1(l,3)
- a_temp(2,2)=aggj1(l,4)
- call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
- call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
- s1=scalar2(b1(1,iti2),auxvec(1))
- call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
- call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
- s2=scalar2(b1(1,iti1),auxvec(1))
- call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
- call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
- s3=0.5d0*(pizda(1,1)+pizda(2,2))
-c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
- gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
- enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine vecpr(u,v,w)
- implicit real*8(a-h,o-z)
- dimension u(3),v(3),w(3)
- w(1)=u(2)*v(3)-u(3)*v(2)
- w(2)=-u(1)*v(3)+u(3)*v(1)
- w(3)=u(1)*v(2)-u(2)*v(1)
- return
- end
-C-----------------------------------------------------------------------------
- subroutine unormderiv(u,ugrad,unorm,ungrad)
-C This subroutine computes the derivatives of a normalized vector u, given
-C the derivatives computed without normalization conditions, ugrad. Returns
-C ungrad.
- implicit none
- double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
- double precision vec(3)
- double precision scalar
- integer i,j
-c write (2,*) 'ugrad',ugrad
-c write (2,*) 'u',u
- do i=1,3
- vec(i)=scalar(ugrad(1,i),u(1))
- enddo
-c write (2,*) 'vec',vec
- do i=1,3
- do j=1,3
- ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
- enddo
- enddo
-c write (2,*) 'ungrad',ungrad
- return
- end
-C-----------------------------------------------------------------------------
- subroutine escp_soft_sphere(evdw2,evdw2_14)
-C
-C This subroutine calculates the excluded-volume interaction energy between
-C peptide-group centers and side chains and its gradient in virtual-bond and
-C side-chain vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- evdw2=0.0D0
- evdw2_14=0.0d0
- r0_scp=4.5d0
-cd print '(a)','Enter ESCP'
-cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
- do i=iatscp_s,iatscp_e
- iteli=itel(i)
- xi=0.5D0*(c(1,i)+c(1,i+1))
- yi=0.5D0*(c(2,i)+c(2,i+1))
- zi=0.5D0*(c(3,i)+c(3,i+1))
-
- do iint=1,nscp_gr(i)
-
- do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
-C Uncomment following three lines for SC-p interactions
-c xj=c(1,nres+j)-xi
-c yj=c(2,nres+j)-yi
-c zj=c(3,nres+j)-zi
-C Uncomment following three lines for Ca-p interactions
- xj=c(1,j)-xi
- yj=c(2,j)-yi
- zj=c(3,j)-zi
- rij=xj*xj+yj*yj+zj*zj
- r0ij=r0_scp
- r0ijsq=r0ij*r0ij
- if (rij.lt.r0ijsq) then
- evdwij=0.25d0*(rij-r0ijsq)**2
- fac=rij-r0ijsq
- else
- evdwij=0.0d0
- fac=0.0d0
- endif
- evdw2=evdw2+evdwij
-C
-C Calculate contributions to the gradient in the virtual-bond and SC vectors.
-C
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-cgrad if (j.lt.i) then
-cd write (iout,*) 'j<i'
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-cgrad else
-cd write (iout,*) 'j>i'
-cgrad do k=1,3
-cgrad ggg(k)=-ggg(k)
-C Uncomment following line for SC-p interactions
-c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
-cgrad enddo
-cgrad endif
-cgrad do k=1,3
-cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
-cgrad enddo
-cgrad kstart=min0(i+1,j)
-cgrad kend=max0(i-1,j-1)
-cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
-cd write (iout,*) ggg(1),ggg(2),ggg(3)
-cgrad do k=kstart,kend
-cgrad do l=1,3
-cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
-cgrad enddo
-cgrad enddo
- do k=1,3
- gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
- gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
- enddo
- enddo
-
- enddo ! iint
- enddo ! i
- return
- end
-C-----------------------------------------------------------------------------
- subroutine escp(evdw2,evdw2_14)
-C
-C This subroutine calculates the excluded-volume interaction energy between
-C peptide-group centers and side chains and its gradient in virtual-bond and
-C side-chain vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- dimension ggg(3)
- evdw2=0.0D0
- evdw2_14=0.0d0
-cd print '(a)','Enter ESCP'
-cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
- do i=iatscp_s,iatscp_e
- iteli=itel(i)
- xi=0.5D0*(c(1,i)+c(1,i+1))
- yi=0.5D0*(c(2,i)+c(2,i+1))
- zi=0.5D0*(c(3,i)+c(3,i+1))
-
- do iint=1,nscp_gr(i)
-
- do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
-C Uncomment following three lines for SC-p interactions
-c xj=c(1,nres+j)-xi
-c yj=c(2,nres+j)-yi
-c zj=c(3,nres+j)-zi
-C Uncomment following three lines for Ca-p interactions
- xj=c(1,j)-xi
- yj=c(2,j)-yi
- zj=c(3,j)-zi
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- fac=rrij**expon2
- e1=fac*fac*aad(itypj,iteli)
- e2=fac*bad(itypj,iteli)
- if (iabs(j-i) .le. 2) then
- e1=scal14*e1
- e2=scal14*e2
- evdw2_14=evdw2_14+e1+e2
- endif
- evdwij=e1+e2
- evdw2=evdw2+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw2',i,j,evdwij
-C
-C Calculate contributions to the gradient in the virtual-bond and SC vectors.
-C
- fac=-(evdwij+e1)*rrij
- ggg(1)=xj*fac
- ggg(2)=yj*fac
- ggg(3)=zj*fac
-cgrad if (j.lt.i) then
-cd write (iout,*) 'j<i'
-C Uncomment following three lines for SC-p interactions
-c do k=1,3
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-c enddo
-cgrad else
-cd write (iout,*) 'j>i'
-cgrad do k=1,3
-cgrad ggg(k)=-ggg(k)
-C Uncomment following line for SC-p interactions
-ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
-c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
-cgrad enddo
-cgrad endif
-cgrad do k=1,3
-cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
-cgrad enddo
-cgrad kstart=min0(i+1,j)
-cgrad kend=max0(i-1,j-1)
-cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
-cd write (iout,*) ggg(1),ggg(2),ggg(3)
-cgrad do k=kstart,kend
-cgrad do l=1,3
-cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
-cgrad enddo
-cgrad enddo
- do k=1,3
- gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
- gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
- enddo
- enddo
-
- enddo ! iint
- enddo ! i
- do i=1,nct
- do j=1,3
- gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
- gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
- gradx_scp(j,i)=expon*gradx_scp(j,i)
- enddo
- enddo
-C******************************************************************************
-C
-C N O T E !!!
-C
-C To save time the factor EXPON has been extracted from ALL components
-C of GVDWC and GRADX. Remember to multiply them by this factor before further
-C use!
-C
-C******************************************************************************
- return
- end
-C--------------------------------------------------------------------------
- subroutine edis(ehpb)
-C
-C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- dimension ggg(3)
- ehpb=0.0D0
-cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
-cd write(iout,*)'link_start=',link_start,' link_end=',link_end
- if (link_end.eq.0) return
- do i=link_start,link_end
-C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
-C CA-CA distance used in regularization of structure.
- ii=ihpb(i)
- jj=jhpb(i)
-C iii and jjj point to the residues for which the distance is assigned.
- if (ii.gt.nres) then
- iii=ii-nres
- jjj=jj-nres
- else
- iii=ii
- jjj=jj
- endif
-c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
-c & dhpb(i),dhpb1(i),forcon(i)
-C 24/11/03 AL: SS bridges handled separately because of introducing a specific
-C distance and angle dependent SS bond potential.
-cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
-C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
- if (.not.dyn_ss .and. i.le.nss) then
-C 15/02/13 CC dynamic SSbond - additional check
- if (ii.gt.nres
- & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
- call ssbond_ene(iii,jjj,eij)
- ehpb=ehpb+2*eij
- endif
-cd write (iout,*) "eij",eij
- else if (ii.gt.nres .and. jj.gt.nres) then
-c Restraints from contact prediction
- dd=dist(ii,jj)
- if (dhpb1(i).gt.0.0d0) then
- ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
-c write (iout,*) "beta nmr",
-c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- else
- dd=dist(ii,jj)
- rdis=dd-dhpb(i)
-C Get the force constant corresponding to this distance.
- waga=forcon(i)
-C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
-c write (iout,*) "beta reg",dd,waga*rdis*rdis
-C
-C Evaluate gradient.
-C
- fac=waga*rdis/dd
- endif
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
- do j=1,3
- ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
- ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
- enddo
- do k=1,3
- ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
- ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
- enddo
- else
-C Calculate the distance between the two points and its difference from the
-C target distance.
- dd=dist(ii,jj)
- if (dhpb1(i).gt.0.0d0) then
- ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
-c write (iout,*) "alph nmr",
-c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
- else
- rdis=dd-dhpb(i)
-C Get the force constant corresponding to this distance.
- waga=forcon(i)
-C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
-c write (iout,*) "alpha reg",dd,waga*rdis*rdis
-C
-C Evaluate gradient.
-C
- fac=waga*rdis/dd
- endif
-cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
-cd & ' waga=',waga,' fac=',fac
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
-cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
-C If this is a SC-SC distance, we need to calculate the contributions to the
-C Cartesian gradient in the SC vectors (ghpbx).
- if (iii.lt.ii) then
- do j=1,3
- ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
- ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
- enddo
- endif
-cgrad do j=iii,jjj-1
-cgrad do k=1,3
-cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
-cgrad enddo
-cgrad enddo
- do k=1,3
- ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
- ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
- enddo
- endif
- enddo
- ehpb=0.5D0*ehpb
- return
- end
-C--------------------------------------------------------------------------
- subroutine ssbond_ene(i,j,eij)
-C
-C Calculate the distance and angle dependent SS-bond potential energy
-C using a free-energy function derived based on RHF/6-31G** ab initio
-C calculations of diethyl disulfide.
-C
-C A. Liwo and U. Kozlowska, 11/24/03
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
- itypi=itype(i)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
-c dsci_inv=dsc_inv(itypi)
- dsci_inv=vbld_inv(nres+i)
- itypj=itype(j)
-c dscj_inv=dsc_inv(itypj)
- dscj_inv=vbld_inv(nres+j)
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- erij(1)=xj*rij
- erij(2)=yj*rij
- erij(3)=zj*rij
- om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
- om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
- om12=dxi*dxj+dyi*dyj+dzi*dzj
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
- dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
- enddo
- rij=1.0d0/rij
- deltad=rij-d0cm
- deltat1=1.0d0-om1
- deltat2=1.0d0+om2
- deltat12=om2-om1+2.0d0
- cosphi=om12-om1*om2
- eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
- & +akct*deltad*deltat12+ebr
- & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
-c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
-c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
-c & " deltat12",deltat12," eij",eij
- ed=2*akcm*deltad+akct*deltat12
- pom1=akct*deltad
- pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
- eom1=-2*akth*deltat1-pom1-om2*pom2
- eom2= 2*akth*deltat2+pom1-om1*pom2
- eom12=pom2
- do k=1,3
- ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- ghpbx(k,i)=ghpbx(k,i)-ggk
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- ghpbx(k,j)=ghpbx(k,j)+ggk
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- ghpbc(k,i)=ghpbc(k,i)-ggk
- ghpbc(k,j)=ghpbc(k,j)+ggk
- enddo
-C
-C Calculate the components of the gradient in DC and X
-C
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
- return
- end
-C--------------------------------------------------------------------------
- subroutine ebond(estr)
-c
-c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- double precision u(3),ud(3)
- estr=0.0d0
- do i=ibondp_start,ibondp_end
- diff = vbld(i)-vbldp0
-c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
- estr=estr+diff*diff
- do j=1,3
- gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
- enddo
-c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
- enddo
- estr=0.5d0*AKP*estr
-c
-c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
-c
- do i=ibond_start,ibond_end
- iti=itype(i)
- if (iti.ne.10) then
- nbi=nbondterm(iti)
- if (nbi.eq.1) then
- diff=vbld(i+nres)-vbldsc0(1,iti)
-c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
-c & AKSC(1,iti),AKSC(1,iti)*diff*diff
- estr=estr+0.5d0*AKSC(1,iti)*diff*diff
- do j=1,3
- gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
- enddo
- else
- do j=1,nbi
- diff=vbld(i+nres)-vbldsc0(j,iti)
- ud(j)=aksc(j,iti)*diff
- u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
- enddo
- uprod=u(1)
- do j=2,nbi
- uprod=uprod*u(j)
- enddo
- usum=0.0d0
- usumsqder=0.0d0
- do j=1,nbi
- uprod1=1.0d0
- uprod2=1.0d0
- do k=1,nbi
- if (k.ne.j) then
- uprod1=uprod1*u(k)
- uprod2=uprod2*u(k)*u(k)
- endif
- enddo
- usum=usum+uprod1
- usumsqder=usumsqder+ud(j)*uprod2
- enddo
- estr=estr+uprod/usum
- do j=1,3
- gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
- enddo
- endif
- endif
- enddo
- return
- end
-#ifdef CRYST_THETA
-C--------------------------------------------------------------------------
- subroutine ebend(etheta)
-C
-C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
-C angles gamma and its derivatives in consecutive thetas and gammas.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- common /calcthet/ term1,term2,termm,diffak,ratak,
- & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
- & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
- double precision y(2),z(2)
- delta=0.02d0*pi
-c time11=dexp(-2*time)
-c time12=1.0d0
- etheta=0.0D0
-c write (*,'(a,i2)') 'EBEND ICG=',icg
- do i=ithet_start,ithet_end
-C Zero the energy function and its derivative at 0 or pi.
- call splinthet(theta(i),0.5d0*delta,ss,ssd)
- it=itype(i-1)
- if (i.gt.3) then
-#ifdef OSF
- phii=phi(i)
- if (phii.ne.phii) phii=150.0
-#else
- phii=phi(i)
-#endif
- y(1)=dcos(phii)
- y(2)=dsin(phii)
- else
- y(1)=0.0D0
- y(2)=0.0D0
- endif
- if (i.lt.nres) then
-#ifdef OSF
- phii1=phi(i+1)
- if (phii1.ne.phii1) phii1=150.0
- phii1=pinorm(phii1)
- z(1)=cos(phii1)
-#else
- phii1=phi(i+1)
- z(1)=dcos(phii1)
-#endif
- z(2)=dsin(phii1)
- else
- z(1)=0.0D0
- z(2)=0.0D0
- endif
-C Calculate the "mean" value of theta from the part of the distribution
-C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
-C In following comments this theta will be referred to as t_c.
- thet_pred_mean=0.0d0
- do k=1,2
- athetk=athet(k,it)
- bthetk=bthet(k,it)
- thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
- enddo
- dthett=thet_pred_mean*ssd
- thet_pred_mean=thet_pred_mean*ss+a0thet(it)
-C Derivatives of the "mean" values in gamma1 and gamma2.
- dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
- dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
- if (theta(i).gt.pi-delta) then
- call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
- & E_tc0)
- call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
- call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
- call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
- & E_theta)
- call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
- & E_tc)
- else if (theta(i).lt.delta) then
- call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
- call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
- call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
- & E_theta)
- call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
- call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
- & E_tc)
- else
- call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
- & E_theta,E_tc)
- endif
- etheta=etheta+ethetai
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'ebend',i,ethetai
- if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
- if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
- gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
- enddo
-C Ufff.... We've done all this!!!
- return
- end
-C---------------------------------------------------------------------------
- subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
- & E_tc)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /calcthet/ term1,term2,termm,diffak,ratak,
- & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
- & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
-C Calculate the contributions to both Gaussian lobes.
-C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
-C The "polynomial part" of the "standard deviation" of this part of
-C the distribution.
- sig=polthet(3,it)
- do j=2,0,-1
- sig=sig*thet_pred_mean+polthet(j,it)
- enddo
-C Derivative of the "interior part" of the "standard deviation of the"
-C gamma-dependent Gaussian lobe in t_c.
- sigtc=3*polthet(3,it)
- do j=2,1,-1
- sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
- enddo
- sigtc=sig*sigtc
-C Set the parameters of both Gaussian lobes of the distribution.
-C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
- fac=sig*sig+sigc0(it)
- sigcsq=fac+fac
- sigc=1.0D0/sigcsq
-C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
- sigsqtc=-4.0D0*sigcsq*sigtc
-c print *,i,sig,sigtc,sigsqtc
-C Following variable (sigtc) is d[sigma(t_c)]/dt_c
- sigtc=-sigtc/(fac*fac)
-C Following variable is sigma(t_c)**(-2)
- sigcsq=sigcsq*sigcsq
- sig0i=sig0(it)
- sig0inv=1.0D0/sig0i**2
- delthec=thetai-thet_pred_mean
- delthe0=thetai-theta0i
- term1=-0.5D0*sigcsq*delthec*delthec
- term2=-0.5D0*sig0inv*delthe0*delthe0
-C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
-C NaNs in taking the logarithm. We extract the largest exponent which is added
-C to the energy (this being the log of the distribution) at the end of energy
-C term evaluation for this virtual-bond angle.
- if (term1.gt.term2) then
- termm=term1
- term2=dexp(term2-termm)
- term1=1.0d0
- else
- termm=term2
- term1=dexp(term1-termm)
- term2=1.0d0
- endif
-C The ratio between the gamma-independent and gamma-dependent lobes of
-C the distribution is a Gaussian function of thet_pred_mean too.
- diffak=gthet(2,it)-thet_pred_mean
- ratak=diffak/gthet(3,it)**2
- ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
-C Let's differentiate it in thet_pred_mean NOW.
- aktc=ak*ratak
-C Now put together the distribution terms to make complete distribution.
- termexp=term1+ak*term2
- termpre=sigc+ak*sig0i
-C Contribution of the bending energy from this theta is just the -log of
-C the sum of the contributions from the two lobes and the pre-exponential
-C factor. Simple enough, isn't it?
- ethetai=(-dlog(termexp)-termm+dlog(termpre))
-C NOW the derivatives!!!
-C 6/6/97 Take into account the deformation.
- E_theta=(delthec*sigcsq*term1
- & +ak*delthe0*sig0inv*term2)/termexp
- E_tc=((sigtc+aktc*sig0i)/termpre
- & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
- & aktc*term2)/termexp)
- return
- end
-c-----------------------------------------------------------------------------
- subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /calcthet/ term1,term2,termm,diffak,ratak,
- & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
- & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
- delthec=thetai-thet_pred_mean
- delthe0=thetai-theta0i
-C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
- t3 = thetai-thet_pred_mean
- t6 = t3**2
- t9 = term1
- t12 = t3*sigcsq
- t14 = t12+t6*sigsqtc
- t16 = 1.0d0
- t21 = thetai-theta0i
- t23 = t21**2
- t26 = term2
- t27 = t21*t26
- t32 = termexp
- t40 = t32**2
- E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
- & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
- & *(-t12*t9-ak*sig0inv*t27)
- return
- end
-#else
-C--------------------------------------------------------------------------
- subroutine ebend(etheta)
-C
-C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
-C angles gamma and its derivatives in consecutive thetas and gammas.
-C ab initio-derived potentials from
-c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
- & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
- & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
- & sinph1ph2(maxdouble,maxdouble)
- logical lprn /.false./, lprn1 /.false./
- etheta=0.0D0
- do i=ithet_start,ithet_end
- dethetai=0.0d0
- dephii=0.0d0
- dephii1=0.0d0
- theti2=0.5d0*theta(i)
- ityp2=ithetyp(itype(i-1))
- do k=1,nntheterm
- coskt(k)=dcos(k*theti2)
- sinkt(k)=dsin(k*theti2)
- enddo
- if (i.gt.3) then
-#ifdef OSF
- phii=phi(i)
- if (phii.ne.phii) phii=150.0
-#else
- phii=phi(i)
-#endif
- ityp1=ithetyp(itype(i-2))
- do k=1,nsingle
- cosph1(k)=dcos(k*phii)
- sinph1(k)=dsin(k*phii)
- enddo
- else
- phii=0.0d0
- ityp1=nthetyp+1
- do k=1,nsingle
- cosph1(k)=0.0d0
- sinph1(k)=0.0d0
- enddo
- endif
- if (i.lt.nres) then
-#ifdef OSF
- phii1=phi(i+1)
- if (phii1.ne.phii1) phii1=150.0
- phii1=pinorm(phii1)
-#else
- phii1=phi(i+1)
-#endif
- ityp3=ithetyp(itype(i))
- do k=1,nsingle
- cosph2(k)=dcos(k*phii1)
- sinph2(k)=dsin(k*phii1)
- enddo
- else
- phii1=0.0d0
- ityp3=nthetyp+1
- do k=1,nsingle
- cosph2(k)=0.0d0
- sinph2(k)=0.0d0
- enddo
- endif
- ethetai=aa0thet(ityp1,ityp2,ityp3)
- do k=1,ndouble
- do l=1,k-1
- ccl=cosph1(l)*cosph2(k-l)
- ssl=sinph1(l)*sinph2(k-l)
- scl=sinph1(l)*cosph2(k-l)
- csl=cosph1(l)*sinph2(k-l)
- cosph1ph2(l,k)=ccl-ssl
- cosph1ph2(k,l)=ccl+ssl
- sinph1ph2(l,k)=scl+csl
- sinph1ph2(k,l)=scl-csl
- enddo
- enddo
- if (lprn) then
- write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
- & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
- write (iout,*) "coskt and sinkt"
- do k=1,nntheterm
- write (iout,*) k,coskt(k),sinkt(k)
- enddo
- endif
- do k=1,ntheterm
- ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
- dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
- & *coskt(k)
- if (lprn)
- & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
- & " ethetai",ethetai
- enddo
- if (lprn) then
- write (iout,*) "cosph and sinph"
- do k=1,nsingle
- write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
- enddo
- write (iout,*) "cosph1ph2 and sinph2ph2"
- do k=2,ndouble
- do l=1,k-1
- write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
- & sinph1ph2(l,k),sinph1ph2(k,l)
- enddo
- enddo
- write(iout,*) "ethetai",ethetai
- endif
- do m=1,ntheterm2
- do k=1,nsingle
- aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
- & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
- & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
- & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
- ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*aux*coskt(m)
- dephii=dephii+k*sinkt(m)*(
- & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
- & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
- dephii1=dephii1+k*sinkt(m)*(
- & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
- & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
- if (lprn)
- & write (iout,*) "m",m," k",k," bbthet",
- & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
- & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
- & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
- & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- enddo
- enddo
- if (lprn)
- & write(iout,*) "ethetai",ethetai
- do m=1,ntheterm3
- do k=2,ndouble
- do l=1,k-1
- aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
- & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
- & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
- ethetai=ethetai+sinkt(m)*aux
- dethetai=dethetai+0.5d0*m*coskt(m)*aux
- dephii=dephii+l*sinkt(m)*(
- & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
- & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
- & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- dephii1=dephii1+(k-l)*sinkt(m)*(
- & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
- & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
- & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
- if (lprn) then
- write (iout,*) "m",m," k",k," l",l," ffthet",
- & ffthet(l,k,m,ityp1,ityp2,ityp3),
- & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
- & ggthet(l,k,m,ityp1,ityp2,ityp3),
- & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
- write (iout,*) cosph1ph2(l,k)*sinkt(m),
- & cosph1ph2(k,l)*sinkt(m),
- & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
- endif
- enddo
- enddo
- enddo
-10 continue
-c lprn1=.true.
- if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)')
- & 'ebe', i,theta(i)*rad2deg,phii*rad2deg,
- & phii1*rad2deg,ethetai
-c lprn1=.false.
- etheta=etheta+ethetai
- if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
- if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
- gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
- enddo
- return
- end
-#endif
-#ifdef CRYST_SC
-c-----------------------------------------------------------------------------
- subroutine esc(escloc)
-C Calculate the local energy of a side chain and its derivatives in the
-C corresponding virtual-bond valence angles THETA and the spherical angles
-C ALPHA and OMEGA.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
- & ddersc0(3),ddummy(3),xtemp(3),temp(3)
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- delta=0.02d0*pi
- escloc=0.0D0
-c write (iout,'(a)') 'ESC'
- do i=loc_start,loc_end
- it=itype(i)
- if (it.eq.10) goto 1
- nlobit=nlob(it)
-c print *,'i=',i,' it=',it,' nlobit=',nlobit
-c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
- theti=theta(i+1)-pipol
- x(1)=dtan(theti)
- x(2)=alph(i)
- x(3)=omeg(i)
-
- if (x(2).gt.pi-delta) then
- xtemp(1)=x(1)
- xtemp(2)=pi-delta
- xtemp(3)=x(3)
- call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
- xtemp(2)=pi
- call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
- call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
- & escloci,dersc(2))
- call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
- & ddersc0(1),dersc(1))
- call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
- & ddersc0(3),dersc(3))
- xtemp(2)=pi-delta
- call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
- xtemp(2)=pi
- call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
- call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
- & dersc0(2),esclocbi,dersc02)
- call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
- & dersc12,dersc01)
- call splinthet(x(2),0.5d0*delta,ss,ssd)
- dersc0(1)=dersc01
- dersc0(2)=dersc02
- dersc0(3)=0.0d0
- do k=1,3
- dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
- enddo
- dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c & esclocbi,ss,ssd
- escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c escloci=esclocbi
-c write (iout,*) escloci
- else if (x(2).lt.delta) then
- xtemp(1)=x(1)
- xtemp(2)=delta
- xtemp(3)=x(3)
- call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
- xtemp(2)=0.0d0
- call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
- call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
- & escloci,dersc(2))
- call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
- & ddersc0(1),dersc(1))
- call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
- & ddersc0(3),dersc(3))
- xtemp(2)=delta
- call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
- xtemp(2)=0.0d0
- call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
- call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
- & dersc0(2),esclocbi,dersc02)
- call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
- & dersc12,dersc01)
- dersc0(1)=dersc01
- dersc0(2)=dersc02
- dersc0(3)=0.0d0
- call splinthet(x(2),0.5d0*delta,ss,ssd)
- do k=1,3
- dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
- enddo
- dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c & esclocbi,ss,ssd
- escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c write (iout,*) escloci
- else
- call enesc(x,escloci,dersc,ddummy,.false.)
- endif
-
- escloc=escloc+escloci
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'escloc',i,escloci
-c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
-
- gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
- & wscloc*dersc(1)
- gloc(ialph(i,1),icg)=wscloc*dersc(2)
- gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
- 1 continue
- enddo
- return
- end
-C---------------------------------------------------------------------------
- subroutine enesc(x,escloci,dersc,ddersc,mixed)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
- double precision contr(maxlob,-1:1)
- logical mixed
-c write (iout,*) 'it=',it,' nlobit=',nlobit
- escloc_i=0.0D0
- do j=1,3
- dersc(j)=0.0D0
- if (mixed) ddersc(j)=0.0d0
- enddo
- x3=x(3)
-
-C Because of periodicity of the dependence of the SC energy in omega we have
-C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
-C To avoid underflows, first compute & store the exponents.
-
- do iii=-1,1
-
- x(3)=x3+iii*dwapi
-
- do j=1,nlobit
- do k=1,3
- z(k)=x(k)-censc(k,j,it)
- enddo
- do k=1,3
- Axk=0.0D0
- do l=1,3
- Axk=Axk+gaussc(l,k,j,it)*z(l)
- enddo
- Ax(k,j,iii)=Axk
- enddo
- expfac=0.0D0
- do k=1,3
- expfac=expfac+Ax(k,j,iii)*z(k)
- enddo
- contr(j,iii)=expfac
- enddo ! j
-
- enddo ! iii
-
- x(3)=x3
-C As in the case of ebend, we want to avoid underflows in exponentiation and
-C subsequent NaNs and INFs in energy calculation.
-C Find the largest exponent
- emin=contr(1,-1)
- do iii=-1,1
- do j=1,nlobit
- if (emin.gt.contr(j,iii)) emin=contr(j,iii)
- enddo
- enddo
- emin=0.5D0*emin
-cd print *,'it=',it,' emin=',emin
-
-C Compute the contribution to SC energy and derivatives
- do iii=-1,1
-
- do j=1,nlobit
-#ifdef OSF
- adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
- if(adexp.ne.adexp) adexp=1.0
- expfac=dexp(adexp)
-#else
- expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
-#endif
-cd print *,'j=',j,' expfac=',expfac
- escloc_i=escloc_i+expfac
- do k=1,3
- dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
- enddo
- if (mixed) then
- do k=1,3,2
- ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
- & +gaussc(k,2,j,it))*expfac
- enddo
- endif
- enddo
-
- enddo ! iii
-
- dersc(1)=dersc(1)/cos(theti)**2
- ddersc(1)=ddersc(1)/cos(theti)**2
- ddersc(3)=ddersc(3)
-
- escloci=-(dlog(escloc_i)-emin)
- do j=1,3
- dersc(j)=dersc(j)/escloc_i
- enddo
- if (mixed) then
- do j=1,3,2
- ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
- enddo
- endif
- return
- end
-C------------------------------------------------------------------------------
- subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- double precision x(3),z(3),Ax(3,maxlob),dersc(3)
- double precision contr(maxlob)
- logical mixed
-
- escloc_i=0.0D0
-
- do j=1,3
- dersc(j)=0.0D0
- enddo
-
- do j=1,nlobit
- do k=1,2
- z(k)=x(k)-censc(k,j,it)
- enddo
- z(3)=dwapi
- do k=1,3
- Axk=0.0D0
- do l=1,3
- Axk=Axk+gaussc(l,k,j,it)*z(l)
- enddo
- Ax(k,j)=Axk
- enddo
- expfac=0.0D0
- do k=1,3
- expfac=expfac+Ax(k,j)*z(k)
- enddo
- contr(j)=expfac
- enddo ! j
-
-C As in the case of ebend, we want to avoid underflows in exponentiation and
-C subsequent NaNs and INFs in energy calculation.
-C Find the largest exponent
- emin=contr(1)
- do j=1,nlobit
- if (emin.gt.contr(j)) emin=contr(j)
- enddo
- emin=0.5D0*emin
-
-C Compute the contribution to SC energy and derivatives
-
- dersc12=0.0d0
- do j=1,nlobit
- expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
- escloc_i=escloc_i+expfac
- do k=1,2
- dersc(k)=dersc(k)+Ax(k,j)*expfac
- enddo
- if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
- & +gaussc(1,2,j,it))*expfac
- dersc(3)=0.0d0
- enddo
-
- dersc(1)=dersc(1)/cos(theti)**2
- dersc12=dersc12/cos(theti)**2
- escloci=-(dlog(escloc_i)-emin)
- do j=1,2
- dersc(j)=dersc(j)/escloc_i
- enddo
- if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
- return
- end
-#else
-c----------------------------------------------------------------------------------
- subroutine esc(escloc)
-C Calculate the local energy of a side chain and its derivatives in the
-C corresponding virtual-bond valence angles THETA and the spherical angles
-C ALPHA and OMEGA derived from AM1 all-atom calculations.
-C added by Urszula Kozlowska. 07/11/2007
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.SCROT'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- include 'COMMON.VECTORS'
- double precision x_prime(3),y_prime(3),z_prime(3)
- & , sumene,dsc_i,dp2_i,x(65),
- & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
- & de_dxx,de_dyy,de_dzz,de_dt
- double precision s1_t,s1_6_t,s2_t,s2_6_t
- double precision
- & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
- & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
- & dt_dCi(3),dt_dCi1(3)
- common /sccalc/ time11,time12,time112,theti,it,nlobit
- delta=0.02d0*pi
- escloc=0.0D0
- do i=loc_start,loc_end
- costtab(i+1) =dcos(theta(i+1))
- sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
- cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
- sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
- cosfac2=0.5d0/(1.0d0+costtab(i+1))
- cosfac=dsqrt(cosfac2)
- sinfac2=0.5d0/(1.0d0-costtab(i+1))
- sinfac=dsqrt(sinfac2)
- it=itype(i)
- if (it.eq.10) goto 1
-c
-C Compute the axes of tghe local cartesian coordinates system; store in
-c x_prime, y_prime and z_prime
-c
- do j=1,3
- x_prime(j) = 0.00
- y_prime(j) = 0.00
- z_prime(j) = 0.00
- enddo
-C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
-C & dc_norm(3,i+nres)
- do j = 1,3
- x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
- y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
- enddo
- do j = 1,3
- z_prime(j) = -uz(j,i-1)
- enddo
-c write (2,*) "i",i
-c write (2,*) "x_prime",(x_prime(j),j=1,3)
-c write (2,*) "y_prime",(y_prime(j),j=1,3)
-c write (2,*) "z_prime",(z_prime(j),j=1,3)
-c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
-c & " xy",scalar(x_prime(1),y_prime(1)),
-c & " xz",scalar(x_prime(1),z_prime(1)),
-c & " yy",scalar(y_prime(1),y_prime(1)),
-c & " yz",scalar(y_prime(1),z_prime(1)),
-c & " zz",scalar(z_prime(1),z_prime(1))
-c
-C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
-C to local coordinate system. Store in xx, yy, zz.
-c
- xx=0.0d0
- yy=0.0d0
- zz=0.0d0
- do j = 1,3
- xx = xx + x_prime(j)*dc_norm(j,i+nres)
- yy = yy + y_prime(j)*dc_norm(j,i+nres)
- zz = zz + z_prime(j)*dc_norm(j,i+nres)
- enddo
-
- xxtab(i)=xx
- yytab(i)=yy
- zztab(i)=zz
-C
-C Compute the energy of the ith side cbain
-C
-c write (2,*) "xx",xx," yy",yy," zz",zz
- it=itype(i)
- do j = 1,65
- x(j) = sc_parmin(j,it)
- enddo
-#ifdef CHECK_COORD
-Cc diagnostics - remove later
- xx1 = dcos(alph(2))
- yy1 = dsin(alph(2))*dcos(omeg(2))
- zz1 = -dsin(alph(2))*dsin(omeg(2))
- write(2,'(3f8.1,3f9.3,1x,3f9.3)')
- & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
- & xx1,yy1,zz1
-C," --- ", xx_w,yy_w,zz_w
-c end diagnostics
-#endif
- sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
- & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
- & + x(10)*yy*zz
- sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
- & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
- & + x(20)*yy*zz
- sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
- & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
- & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
- & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
- & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
- & +x(40)*xx*yy*zz
- sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
- & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
- & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
- & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
- & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
- & +x(60)*xx*yy*zz
- dsc_i = 0.743d0+x(61)
- dp2_i = 1.9d0+x(62)
- dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
- dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
- s1=(1+x(63))/(0.1d0 + dscp1)
- s1_6=(1+x(64))/(0.1d0 + dscp1**6)
- s2=(1+x(65))/(0.1d0 + dscp2)
- s2_6=(1+x(65))/(0.1d0 + dscp2**6)
- sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
- & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
-c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
-c & sumene4,
-c & dscp1,dscp2,sumene
-c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- escloc = escloc + sumene
-c write (2,*) "i",i," escloc",sumene,escloc
-#ifdef DEBUG
-C
-C This section to check the numerical derivatives of the energy of ith side
-C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
-C #define DEBUG in the code to turn it on.
-C
- write (2,*) "sumene =",sumene
- aincr=1.0d-7
- xxsave=xx
- xx=xx+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dxx_num=(sumenep-sumene)/aincr
- xx=xxsave
- write (2,*) "xx+ sumene from enesc=",sumenep
- yysave=yy
- yy=yy+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dyy_num=(sumenep-sumene)/aincr
- yy=yysave
- write (2,*) "yy+ sumene from enesc=",sumenep
- zzsave=zz
- zz=zz+aincr
- write (2,*) xx,yy,zz
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dzz_num=(sumenep-sumene)/aincr
- zz=zzsave
- write (2,*) "zz+ sumene from enesc=",sumenep
- costsave=cost2tab(i+1)
- sintsave=sint2tab(i+1)
- cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
- sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
- sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
- de_dt_num=(sumenep-sumene)/aincr
- write (2,*) " t+ sumene from enesc=",sumenep
- cost2tab(i+1)=costsave
- sint2tab(i+1)=sintsave
-C End of diagnostics section.
-#endif
-C
-C Compute the gradient of esc
-C
- pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
- pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
- pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
- pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
- pom_dx=dsc_i*dp2_i*cost2tab(i+1)
- pom_dy=dsc_i*dp2_i*sint2tab(i+1)
- pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
- pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
- pom1=(sumene3*sint2tab(i+1)+sumene1)
- & *(pom_s1/dscp1+pom_s16*dscp1**4)
- pom2=(sumene4*cost2tab(i+1)+sumene2)
- & *(pom_s2/dscp2+pom_s26*dscp2**4)
- sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
- sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
- & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
- & +x(40)*yy*zz
- sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
- sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
- & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
- & +x(60)*yy*zz
- de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
- & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
- & +(pom1+pom2)*pom_dx
-#ifdef DEBUG
- write(2,*), "de_dxx = ", de_dxx,de_dxx_num
-#endif
-C
- sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
- sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
- & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
- & +x(40)*xx*zz
- sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
- sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
- & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
- & +x(59)*zz**2 +x(60)*xx*zz
- de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
- & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
- & +(pom1-pom2)*pom_dy
-#ifdef DEBUG
- write(2,*), "de_dyy = ", de_dyy,de_dyy_num
-#endif
-C
- de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
- & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
- & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
- & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
- & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
- & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
- & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
- & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
-#ifdef DEBUG
- write(2,*), "de_dzz = ", de_dzz,de_dzz_num
-#endif
-C
- de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
- & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
- & +pom1*pom_dt1+pom2*pom_dt2
-#ifdef DEBUG
- write(2,*), "de_dt = ", de_dt,de_dt_num
-#endif
-c
-C
- cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
- cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
- cosfac2xx=cosfac2*xx
- sinfac2yy=sinfac2*yy
- do k = 1,3
- dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
- & vbld_inv(i+1)
- dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
- & vbld_inv(i)
- pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
- pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
-c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
-c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
-c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
-c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
- dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
- dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
- dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
- dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
- dZZ_Ci1(k)=0.0d0
- dZZ_Ci(k)=0.0d0
- do j=1,3
- dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
- dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
- enddo
-
- dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
- dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
- dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
-c
- dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
- dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
- enddo
-
- do k=1,3
- dXX_Ctab(k,i)=dXX_Ci(k)
- dXX_C1tab(k,i)=dXX_Ci1(k)
- dYY_Ctab(k,i)=dYY_Ci(k)
- dYY_C1tab(k,i)=dYY_Ci1(k)
- dZZ_Ctab(k,i)=dZZ_Ci(k)
- dZZ_C1tab(k,i)=dZZ_Ci1(k)
- dXX_XYZtab(k,i)=dXX_XYZ(k)
- dYY_XYZtab(k,i)=dYY_XYZ(k)
- dZZ_XYZtab(k,i)=dZZ_XYZ(k)
- enddo
-
- do k = 1,3
-c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
-c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
-c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
-c & dyy_ci(k)," dzz_ci",dzz_ci(k)
-c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
-c & dt_dci(k)
-c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
-c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
- gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
- & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
- gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
- & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
- gsclocx(k,i)= de_dxx*dxx_XYZ(k)
- & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
- enddo
-c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
-c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
-
-C to check gradient call subroutine check_grad
-
- 1 continue
- enddo
- return
- end
-c------------------------------------------------------------------------------
- double precision function enesc(x,xx,yy,zz,cost2,sint2)
- implicit none
- double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
- & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
- sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
- & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
- & + x(10)*yy*zz
- sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
- & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
- & + x(20)*yy*zz
- sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
- & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
- & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
- & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
- & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
- & +x(40)*xx*yy*zz
- sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
- & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
- & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
- & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
- & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
- & +x(60)*xx*yy*zz
- dsc_i = 0.743d0+x(61)
- dp2_i = 1.9d0+x(62)
- dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2+yy*sint2))
- dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
- & *(xx*cost2-yy*sint2))
- s1=(1+x(63))/(0.1d0 + dscp1)
- s1_6=(1+x(64))/(0.1d0 + dscp1**6)
- s2=(1+x(65))/(0.1d0 + dscp2)
- s2_6=(1+x(65))/(0.1d0 + dscp2**6)
- sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
- & + (sumene4*cost2 +sumene2)*(s2+s2_6)
- enesc=sumene
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
-C
-C This procedure calculates two-body contact function g(rij) and its derivative:
-C
-C eps0ij ! x < -1
-C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
-C 0 ! x > 1
-C
-C where x=(rij-r0ij)/delta
-C
-C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
-C
- implicit none
- double precision rij,r0ij,eps0ij,fcont,fprimcont
- double precision x,x2,x4,delta
-c delta=0.02D0*r0ij
-c delta=0.2D0*r0ij
- x=(rij-r0ij)/delta
- if (x.lt.-1.0D0) then
- fcont=eps0ij
- fprimcont=0.0D0
- else if (x.le.1.0D0) then
- x2=x*x
- x4=x2*x2
- fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
- fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
- else
- fcont=0.0D0
- fprimcont=0.0D0
- endif
- return
- end
-c------------------------------------------------------------------------------
- subroutine splinthet(theti,delta,ss,ssder)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- thetup=pi-delta
- thetlow=delta
- if (theti.gt.pipol) then
- call gcont(theti,thetup,1.0d0,delta,ss,ssder)
- else
- call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
- ssder=-ssder
- endif
- return
- end
-c------------------------------------------------------------------------------
- subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
- implicit none
- double precision x,x0,delta,f0,f1,fprim0,f,fprim
- double precision ksi,ksi2,ksi3,a1,a2,a3
- a1=fprim0*delta/(f1-f0)
- a2=3.0d0-2.0d0*a1
- a3=a1-2.0d0
- ksi=(x-x0)/delta
- ksi2=ksi*ksi
- ksi3=ksi2*ksi
- f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
- fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
- return
- end
-c------------------------------------------------------------------------------
- subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
- implicit none
- double precision x,x0,delta,f0x,f1x,fprim0x,fx
- double precision ksi,ksi2,ksi3,a1,a2,a3
- ksi=(x-x0)/delta
- ksi2=ksi*ksi
- ksi3=ksi2*ksi
- a1=fprim0x*delta
- a2=3*(f1x-f0x)-2*fprim0x*delta
- a3=fprim0x*delta-2*(f1x-f0x)
- fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
- return
- end
-C-----------------------------------------------------------------------------
-#ifdef CRYST_TOR
-C-----------------------------------------------------------------------------
- subroutine etor(etors,edihcnstr)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
- etors=0.0D0
- do i=iphi_start,iphi_end
- etors_ii=0.0D0
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
- phii=phi(i)
- gloci=0.0D0
-C Proline-Proline pair is a special case...
- if (itori.eq.3 .and. itori1.eq.3) then
- if (phii.gt.-dwapi3) then
- cosphi=dcos(3*phii)
- fac=1.0D0/(1.0D0-cosphi)
- etorsi=v1(1,3,3)*fac
- etorsi=etorsi+etorsi
- etors=etors+etorsi-v1(1,3,3)
- if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
- gloci=gloci-3*fac*etorsi*dsin(3*phii)
- endif
- do j=1,3
- v1ij=v1(j+1,itori,itori1)
- v2ij=v2(j+1,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- if (energy_dec) etors_ii=etors_ii+
- & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- else
- do j=1,nterm_old
- v1ij=v1(j,itori,itori1)
- v2ij=v2(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- if (energy_dec) etors_ii=etors_ii+
- & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- endif
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'etor',i,etors_ii
- if (lprn)
- & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
- & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
- & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
- gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
- write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
- enddo
-! 6/20/98 - dihedral angle constraints
- edihcnstr=0.0d0
- do i=1,ndih_constr
- itori=idih_constr(i)
- phii=phi(itori)
- difi=phii-phi0(i)
- if (difi.gt.drange(i)) then
- difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- endif
-! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
-! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
- enddo
-! write (iout,*) 'edihcnstr',edihcnstr
- return
- end
-c------------------------------------------------------------------------------
-c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
- subroutine e_modeller(ehomology_constr)
- ehomology_constr=0.0
- write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!"
- return
- end
-C !!!!!!!! NIE CZYTANE !!!!!!!!!!!
-
-c------------------------------------------------------------------------------
- subroutine etor_d(etors_d)
- etors_d=0.0d0
- return
- end
-c----------------------------------------------------------------------------
-#else
- subroutine etor(etors,edihcnstr)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
- etors=0.0D0
- do i=iphi_start,iphi_end
- etors_ii=0.0D0
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
- phii=phi(i)
- gloci=0.0D0
-C Regular cosine and sine terms
- do j=1,nterm(itori,itori1)
- v1ij=v1(j,itori,itori1)
- v2ij=v2(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
- etors=etors+v1ij*cosphi+v2ij*sinphi
- if (energy_dec) etors_ii=etors_ii+
- & v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
-C Lorentz terms
-C v1
-C E = SUM ----------------------------------- - v1
-C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
-C
- cosphi=dcos(0.5d0*phii)
- sinphi=dsin(0.5d0*phii)
- do j=1,nlor(itori,itori1)
- vl1ij=vlor1(j,itori,itori1)
- vl2ij=vlor2(j,itori,itori1)
- vl3ij=vlor3(j,itori,itori1)
- pom=vl2ij*cosphi+vl3ij*sinphi
- pom1=1.0d0/(pom*pom+1.0d0)
- etors=etors+vl1ij*pom1
- if (energy_dec) etors_ii=etors_ii+
- & vl1ij*pom1
- pom=-pom*pom1*pom1
- gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
- enddo
-C Subtract the constant term
- etors=etors-v0(itori,itori1)
- if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'etor',i,etors_ii-v0(itori,itori1)
- if (lprn)
- & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
- & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
- & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
- gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
-c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
- enddo
-! 6/20/98 - dihedral angle constraints
- edihcnstr=0.0d0
-c do i=1,ndih_constr
- do i=idihconstr_start,idihconstr_end
- itori=idih_constr(i)
- phii=phi(itori)
- difi=pinorm(phii-phi0(i))
- if (difi.gt.drange(i)) then
- difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- else if (difi.lt.-drange(i)) then
- difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
- else
- difi=0.0
- endif
-c write (iout,*) "gloci", gloc(i-3,icg)
-cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
-cd & rad2deg*phi0(i), rad2deg*drange(i),
-cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
- enddo
-cd write (iout,*) 'edihcnstr',edihcnstr
- return
- end
-c----------------------------------------------------------------------------
-c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA
- subroutine e_modeller(ehomology_constr)
- implicit real*8 (a-h,o-z)
-
- integer nnn, i, j, k, ki, irec, l
- integer katy, odleglosci, test7
- real*8 odleg, odleg2, odleg3, kat, kat2, kat3
- real*8 distance(799,799,19), dih_diff(799,19)
- real*8 distancek(19), min_odl(799,799)
-
-
- include 'DIMENSIONS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.DERIV'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.MD'
- include 'COMMON.CONTROL'
-
-
- do i=1,19
- distancek(i)=9999999.9
- enddo
-
-
- odleg=0.0
- odleg2=0.0
- kat=0.0
- kat2=0.0
-
-c LICZENIE WKLADU DO ENERGI POCHODZACEGO Z WIEZOW NA ODLEGLOSCI
- do i=1, lim_odl-1
- do j=i+2, lim_odl+1
- do k=1,constr_homology
- distance(i,j,k)=(odl(i,j,k)-dist(i+1,j+1))
- distancek(k)=waga_dist*((distance(i,j,k)**2)/
- & (2*(sigma_odl(i,j,k))**2))
- enddo
-
- min_odl(i,j)=minval(distancek)
-
- do k=1,constr_homology
- odleg3=-waga_dist*((distance(i,j,k)**2)/
- & (2*(sigma_odl(i,j,k))**2))
- odleg2=odleg2+dexp(odleg3+min_odl(i,j))
-
- write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3,
- & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=",
- & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1),
- & "sigma_odl(i,j,k)=", sigma_odl(i,j,k)
-
- enddo
- odleg=odleg-dLOG(odleg2/constr_homology)+min_odl(i,j)
- write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=",
- & dLOG(odleg2),"-odleg=", -odleg
-
- odleg2=0.0
- enddo
- enddo
-
-c LICZENIE WKLADU DO ENERGI POCHODZACEGO Z WIEZOW NA KATY W
- do i=1, lim_dih
- do k=1,constr_homology
- dih_diff(i,k)=(dih(i,k)-beta(i+1,i+2,i+3,i+4))
- if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)=
- & -(6.28318-dih_diff(i,k))
- if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)=
- & 6.28318+dih_diff(i,k)
-
- kat3=-waga_angle*((dih_diff(i,k)**2)/
- & (2*(sigma_dih(i,k))**2))
-c write(iout,*) "w(i,k)=",w(i,k),"beta=",beta(i+1,i+2,i+3,i+4)
- kat2=kat2+dexp(kat3)
-c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3)
-c write(*,*)""
- enddo
- kat=kat-dLOG(kat2/constr_homology)
-
-ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=",
-ccc & dLOG(kat2), "-kat=", -kat
-
- kat2=0.0
- enddo
-
- write(iout,748) "2odleg=", odleg, "kat=", kat,"suma=",odleg+kat
-
-
-
-c ----------------------------------------------------------------------
-c LICZENIE GRADIENTU
-c ----------------------------------------------------------------------
-
- sum_godl=0.0
- sum_sgodl=0.0
-
-c GRADIENT DLA ODLEGLOSCI
- do i=1, lim_odl-1
- do j=i+2, lim_odl+1
- do k=1,constr_homology
- godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
- & *waga_dist)+min_odl(i,j))
- sgodl=godl*((-((distance(i,j,k))/
- & ((sigma_odl(i,j,k))**2)))*waga_dist)
-
- sum_godl=sum_godl+godl
- sum_sgodl=sum_sgodl+sgodl
-
-c sgodl2=sgodl2+sgodl
-c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1"
-c write(iout,*) "constr_homology=",constr_homology
-c write(iout,*) i, j, k, "TEST K"
- enddo
-
- grad_odl3=((1/sum_godl)*sum_sgodl)
- & /dist(i+1,j+1)
- sum_godl=0.0
- sum_sgodl=0.0
-
-
-c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2"
-c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2),
-c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2))
-
-ccc write(iout,*) godl, sgodl, grad_odl3
-
-c grad_odl=grad_odl+grad_odl3
-
- do jik=1,3
- ggodl=grad_odl3*(c(jik,i+1)-c(jik,j+1))
-ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1))
-ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl,
-ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
- ghpbc(jik,i+1)=ghpbc(jik,i+1)+ggodl
- ghpbc(jik,j+1)=ghpbc(jik,j+1)-ggodl
-ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl,
-ccc & ghpbc(jik,i+1), ghpbc(jik,j+1)
-
- enddo
-
- enddo
- enddo
-
-
-c GRADIENT DLA KATOW
- sum_gdih=0.0
- sum_sgdih=0.0
- do i=1, lim_dih
- do k=1,constr_homology
- gdih=dexp((-(dih_diff(i,k)**2)/(2*(sigma_dih(i,k))**2))
- & *waga_angle)
- sgdih=gdih*((-((dih_diff(i,k))/
- & ((sigma_dih(i,k))**2)))*waga_angle)
-
- sum_gdih=sum_gdih+gdih
- sum_sgdih=sum_sgdih+sgdih
- enddo
- grad_dih3=((1.0/sum_gdih)*sum_sgdih)
- sum_gdih=0.0
- sum_sgdih=0.0
-
-c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3
-ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3,
-ccc & gloc(nphi+i-3,icg)
- gloc(i+1,icg)=gloc(i+1,icg)+grad_dih3
-ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3,
-ccc & gloc(nphi+i-3,icg)
-
- enddo
-
-
-c CALKOWITY WKLAD DO ENERGII WYNIKAJACY Z WIEZOW
- ehomology_constr=odleg+kat
- return
-
- 748 format(a8,f12.3,a6,f12.3,a7,f12.3)
- 747 format(a12,i4,i4,i4,f8.3,f8.3)
- 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3)
- 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3)
- 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X,
- & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3)
- end
-
-c------------------------------------------------------------------------------
-
-
-
-
- subroutine etor_d(etors_d)
-C 6/23/01 Compute double torsional energy
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.TORCNSTR'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
- etors_d=0.0D0
- do i=iphid_start,iphid_end
- itori=itortyp(itype(i-2))
- itori1=itortyp(itype(i-1))
- itori2=itortyp(itype(i))
- phii=phi(i)
- phii1=phi(i+1)
- gloci1=0.0D0
- gloci2=0.0D0
- do j=1,ntermd_1(itori,itori1,itori2)
- v1cij=v1c(1,j,itori,itori1,itori2)
- v1sij=v1s(1,j,itori,itori1,itori2)
- v2cij=v1c(2,j,itori,itori1,itori2)
- v2sij=v1s(2,j,itori,itori1,itori2)
- cosphi1=dcos(j*phii)
- sinphi1=dsin(j*phii)
- cosphi2=dcos(j*phii1)
- sinphi2=dsin(j*phii1)
- etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
- & v2cij*cosphi2+v2sij*sinphi2
- gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
- gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
- enddo
- do k=2,ntermd_2(itori,itori1,itori2)
- do l=1,k-1
- v1cdij = v2c(k,l,itori,itori1,itori2)
- v2cdij = v2c(l,k,itori,itori1,itori2)
- v1sdij = v2s(k,l,itori,itori1,itori2)
- v2sdij = v2s(l,k,itori,itori1,itori2)
- cosphi1p2=dcos(l*phii+(k-l)*phii1)
- cosphi1m2=dcos(l*phii-(k-l)*phii1)
- sinphi1p2=dsin(l*phii+(k-l)*phii1)
- sinphi1m2=dsin(l*phii-(k-l)*phii1)
- etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
- & v1sdij*sinphi1p2+v2sdij*sinphi1m2
- gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
- & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
- gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
- & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
- enddo
- enddo
- gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
- gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
-c write (iout,*) "gloci", gloc(i-3,icg)
- enddo
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine eback_sc_corr(esccor)
-c 7/21/2007 Correlations between the backbone-local and side-chain-local
-c conformational states; temporarily implemented as differences
-c between UNRES torsional potentials (dependent on three types of
-c residues) and the torsional potentials dependent on all 20 types
-c of residues computed from AM1 energy surfaces of terminally-blocked
-c amino-acid residues.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.SCCOR'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.CONTROL'
- logical lprn
-C Set lprn=.true. for debugging
- lprn=.false.
-c lprn=.true.
-c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
- esccor=0.0D0
- do i=itau_start,itau_end
- esccor_ii=0.0D0
- isccori=isccortyp(itype(i-2))
- isccori1=isccortyp(itype(i-1))
- phii=phi(i)
-cccc Added 9 May 2012
-cc Tauangle is torsional engle depending on the value of first digit
-c(see comment below)
-cc Omicron is flat angle depending on the value of first digit
-c(see comment below)
-
-
- do intertyp=1,3 !intertyp
-cc Added 09 May 2012 (Adasko)
-cc Intertyp means interaction type of backbone mainchain correlation:
-c 1 = SC...Ca...Ca...Ca
-c 2 = Ca...Ca...Ca...SC
-c 3 = SC...Ca...Ca...SCi
- gloci=0.0D0
- if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
- & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
- & (itype(i-1).eq.21)))
- & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
- & .or.(itype(i-2).eq.21)))
- & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
- & (itype(i-1).eq.21)))) cycle
- if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
- if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
- & cycle
- do j=1,nterm_sccor(isccori,isccori1)
- v1ij=v1sccor(j,intertyp,isccori,isccori1)
- v2ij=v2sccor(j,intertyp,isccori,isccori1)
- cosphi=dcos(j*tauangle(intertyp,i))
- sinphi=dsin(j*tauangle(intertyp,i))
- esccor=esccor+v1ij*cosphi+v2ij*sinphi
- gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
- enddo
- gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
-c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
-c &gloc_sc(intertyp,i-3,icg)
- if (lprn)
- & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
- & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
- & (v1sccor(j,intertyp,itori,itori1),j=1,6)
- & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
- gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
- enddo !intertyp
- enddo
-c do i=1,nres
-c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
-c enddo
- return
- end
-c----------------------------------------------------------------------------
- subroutine multibody(ecorr)
-C This subroutine calculates multi-body contributions to energy following
-C the idea of Skolnick et al. If side chains I and J make a contact and
-C at the same time side chains I+1 and J+1 make a contact, an extra
-C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- double precision gx(3),gx1(3)
- logical lprn
-
-C Set lprn=.true. for debugging
- lprn=.false.
-
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(i2,20(1x,i2,f10.5))')
- & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
- enddo
- endif
- ecorr=0.0D0
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
- do i=nnt,nct-2
-
- DO ISHIFT = 3,4
-
- i1=i+ishift
- num_conti=num_cont(i)
- num_conti1=num_cont(i1)
- do jj=1,num_conti
- j=jcont(jj,i)
- do kk=1,num_conti1
- j1=jcont(kk,i1)
- if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
-cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-cd & ' ishift=',ishift
-C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
-C The system gains extra energy.
- ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
- endif ! j1==j+-ishift
- enddo ! kk
- enddo ! jj
-
- ENDDO ! ISHIFT
-
- enddo ! i
- return
- end
-c------------------------------------------------------------------------------
- double precision function esccorr(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- double precision gx(3),gx1(3)
- logical lprn
- lprn=.false.
- eij=facont(jj,i)
- ekl=facont(kk,k)
-cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
-C Calculate the multi-body contribution to energy.
-C Calculate multi-body contributions to the gradient.
-cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
-cd & k,l,(gacont(m,kk,k),m=1,3)
- do m=1,3
- gx(m) =ekl*gacont(m,jj,i)
- gx1(m)=eij*gacont(m,kk,k)
- gradxorr(m,i)=gradxorr(m,i)-gx(m)
- gradxorr(m,j)=gradxorr(m,j)+gx(m)
- gradxorr(m,k)=gradxorr(m,k)-gx1(m)
- gradxorr(m,l)=gradxorr(m,l)+gx1(m)
- enddo
- do m=i,j-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
- enddo
- enddo
- do m=k,l-1
- do ll=1,3
- gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
- enddo
- enddo
- esccorr=-eij*ekl
- return
- end
-c------------------------------------------------------------------------------
- subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
-C This subroutine calculates multi-body contributions to hydrogen-bonding
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
-#ifdef MPI
- include "mpif.h"
- parameter (max_cont=maxconts)
- parameter (max_dim=26)
- integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
- double precision zapas(max_dim,maxconts,max_fg_procs),
- & zapas_recv(max_dim,maxconts,max_fg_procs)
- common /przechowalnia/ zapas
- integer status(MPI_STATUS_SIZE),req(maxconts*2),
- & status_array(MPI_STATUS_SIZE,maxconts*2)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.CONTROL'
- include 'COMMON.LOCAL'
- double precision gx(3),gx1(3),time00
- logical lprn,ldone
-
-C Set lprn=.true. for debugging
- lprn=.false.
-#ifdef MPI
- n_corr=0
- n_corr1=0
- if (nfgtasks.le.1) goto 30
- if (lprn) then
- write (iout,'(a)') 'Contact function values before RECEIVE:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
- call flush(iout)
- do i=1,ntask_cont_from
- ncont_recv(i)=0
- enddo
- do i=1,ntask_cont_to
- ncont_sent(i)=0
- enddo
-c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
-c & ntask_cont_to
-C Make the list of contacts to send to send to other procesors
-c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
-c call flush(iout)
- do i=iturn3_start,iturn3_end
-c write (iout,*) "make contact list turn3",i," num_cont",
-c & num_cont_hb(i)
- call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
- enddo
- do i=iturn4_start,iturn4_end
-c write (iout,*) "make contact list turn4",i," num_cont",
-c & num_cont_hb(i)
- call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
- enddo
- do ii=1,nat_sent
- i=iat_sent(ii)
-c write (iout,*) "make contact list longrange",i,ii," num_cont",
-c & num_cont_hb(i)
- do j=1,num_cont_hb(i)
- do k=1,4
- jjc=jcont_hb(j,i)
- iproc=iint_sent_local(k,jjc,ii)
-c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
- if (iproc.gt.0) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=i
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=facont_hb(j,i)
- zapas(4,nn,iproc)=ees0p(j,i)
- zapas(5,nn,iproc)=ees0m(j,i)
- zapas(6,nn,iproc)=gacont_hbr(1,j,i)
- zapas(7,nn,iproc)=gacont_hbr(2,j,i)
- zapas(8,nn,iproc)=gacont_hbr(3,j,i)
- zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
- zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
- zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
- zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
- zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
- zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
- zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
- zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
- zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
- zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
- zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
- zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
- zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
- zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
- zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
- zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
- zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
- zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
- endif
- enddo
- enddo
- enddo
- if (lprn) then
- write (iout,*)
- & "Numbers of contacts to be sent to other processors",
- & (ncont_sent(i),i=1,ntask_cont_to)
- write (iout,*) "Contacts sent"
- do ii=1,ntask_cont_to
- nn=ncont_sent(ii)
- iproc=itask_cont_to(ii)
- write (iout,*) nn," contacts to processor",iproc,
- & " of CONT_TO_COMM group"
- do i=1,nn
- write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
- enddo
- enddo
- call flush(iout)
- endif
- CorrelType=477
- CorrelID=fg_rank+1
- CorrelType1=478
- CorrelID1=nfgtasks+fg_rank+1
- ireq=0
-C Receive the numbers of needed contacts from other processors
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- ireq=ireq+1
- call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
- & FG_COMM,req(ireq),IERR)
- enddo
-c write (iout,*) "IRECV ended"
-c call flush(iout)
-C Send the number of contacts needed by other processors
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- ireq=ireq+1
- call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
- & FG_COMM,req(ireq),IERR)
- enddo
-c write (iout,*) "ISEND ended"
-c write (iout,*) "number of requests (nn)",ireq
- call flush(iout)
- if (ireq.gt.0)
- & call MPI_Waitall(ireq,req,status_array,ierr)
-c write (iout,*)
-c & "Numbers of contacts to be received from other processors",
-c & (ncont_recv(i),i=1,ntask_cont_from)
-c call flush(iout)
-C Receive contacts
- ireq=0
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- nn=ncont_recv(ii)
-c write (iout,*) "Receiving",nn," contacts from processor",iproc,
-c & " of CONT_TO_COMM group"
- call flush(iout)
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
- & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-c write (iout,*) "ireq,req",ireq,req(ireq)
- endif
- enddo
-C Send the contacts to processors that need them
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- nn=ncont_sent(ii)
-c write (iout,*) nn," contacts to processor",iproc,
-c & " of CONT_TO_COMM group"
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
- & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-c write (iout,*) "ireq,req",ireq,req(ireq)
-c do i=1,nn
-c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
-c enddo
- endif
- enddo
-c write (iout,*) "number of requests (contacts)",ireq
-c write (iout,*) "req",(req(i),i=1,4)
-c call flush(iout)
- if (ireq.gt.0)
- & call MPI_Waitall(ireq,req,status_array,ierr)
- do iii=1,ntask_cont_from
- iproc=itask_cont_from(iii)
- nn=ncont_recv(iii)
- if (lprn) then
- write (iout,*) "Received",nn," contacts from processor",iproc,
- & " of CONT_FROM_COMM group"
- call flush(iout)
- do i=1,nn
- write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
- enddo
- call flush(iout)
- endif
- do i=1,nn
- ii=zapas_recv(1,i,iii)
-c Flag the received contacts to prevent double-counting
- jj=-zapas_recv(2,i,iii)
-c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
-c call flush(iout)
- nnn=num_cont_hb(ii)+1
- num_cont_hb(ii)=nnn
- jcont_hb(nnn,ii)=jj
- facont_hb(nnn,ii)=zapas_recv(3,i,iii)
- ees0p(nnn,ii)=zapas_recv(4,i,iii)
- ees0m(nnn,ii)=zapas_recv(5,i,iii)
- gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
- gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
- gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
- gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
- gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
- gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
- gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
- gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
- gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
- gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
- gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
- gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
- gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
- gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
- gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
- gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
- gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
- gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
- gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
- gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
- gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
- enddo
- enddo
- call flush(iout)
- if (lprn) then
- write (iout,'(a)') 'Contact function values after receive:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- call flush(iout)
- endif
- 30 continue
-#endif
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
- ecorr=0.0D0
-C Remove the loop below after debugging !!!
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
-C Calculate the local-electrostatic correlation terms
- do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- jp=iabs(j)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
- jp1=iabs(j1)
-c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
- if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
- & .or. j.lt.0 .and. j1.gt.0) .and.
- & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
-C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
-C The system gains extra energy.
- ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
- n_corr=n_corr+1
- else if (j1.eq.j) then
-C Contacts I-J and I-(J+1) occur simultaneously.
-C The system loses extra energy.
-c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
- endif
- enddo ! kk
- do kk=1,num_conti
- j1=jcont_hb(kk,i)
-c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
- if (j1.eq.j+1) then
-C Contacts I-J and (I+1)-J occur simultaneously.
-C The system loses extra energy.
-c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
- endif ! j1==j+1
- enddo ! kk
- enddo ! jj
- enddo ! i
- return
- end
-c------------------------------------------------------------------------------
- subroutine add_hb_contact(ii,jj,itask)
- implicit real*8 (a-h,o-z)
- include "DIMENSIONS"
- include "COMMON.IOUNITS"
- integer max_cont
- integer max_dim
- parameter (max_cont=maxconts)
- parameter (max_dim=26)
- include "COMMON.CONTACTS"
- double precision zapas(max_dim,maxconts,max_fg_procs),
- & zapas_recv(max_dim,maxconts,max_fg_procs)
- common /przechowalnia/ zapas
- integer i,j,ii,jj,iproc,itask(4),nn
-c write (iout,*) "itask",itask
- do i=1,2
- iproc=itask(i)
- if (iproc.gt.0) then
- do j=1,num_cont_hb(ii)
- jjc=jcont_hb(j,ii)
-c write (iout,*) "i",ii," j",jj," jjc",jjc
- if (jjc.eq.jj) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=ii
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=facont_hb(j,ii)
- zapas(4,nn,iproc)=ees0p(j,ii)
- zapas(5,nn,iproc)=ees0m(j,ii)
- zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
- zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
- zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
- zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
- zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
- zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
- zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
- zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
- zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
- zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
- zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
- zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
- zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
- zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
- zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
- zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
- zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
- zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
- zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
- zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
- zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
- exit
- endif
- enddo
- endif
- enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
- & n_corr1)
-C This subroutine calculates multi-body contributions to hydrogen-bonding
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
-#ifdef MPI
- include "mpif.h"
- parameter (max_cont=maxconts)
- parameter (max_dim=70)
- integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
- double precision zapas(max_dim,maxconts,max_fg_procs),
- & zapas_recv(max_dim,maxconts,max_fg_procs)
- common /przechowalnia/ zapas
- integer status(MPI_STATUS_SIZE),req(maxconts*2),
- & status_array(MPI_STATUS_SIZE,maxconts*2)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.CHAIN'
- include 'COMMON.CONTROL'
- double precision gx(3),gx1(3)
- integer num_cont_hb_old(maxres)
- logical lprn,ldone
- double precision eello4,eello5,eelo6,eello_turn6
- external eello4,eello5,eello6,eello_turn6
-C Set lprn=.true. for debugging
- lprn=.false.
- eturn6=0.0d0
-#ifdef MPI
- do i=1,nres
- num_cont_hb_old(i)=num_cont_hb(i)
- enddo
- n_corr=0
- n_corr1=0
- if (nfgtasks.le.1) goto 30
- if (lprn) then
- write (iout,'(a)') 'Contact function values before RECEIVE:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,f5.2))')
- & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
- & j=1,num_cont_hb(i))
- enddo
- endif
- call flush(iout)
- do i=1,ntask_cont_from
- ncont_recv(i)=0
- enddo
- do i=1,ntask_cont_to
- ncont_sent(i)=0
- enddo
-c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
-c & ntask_cont_to
-C Make the list of contacts to send to send to other procesors
- do i=iturn3_start,iturn3_end
-c write (iout,*) "make contact list turn3",i," num_cont",
-c & num_cont_hb(i)
- call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
- enddo
- do i=iturn4_start,iturn4_end
-c write (iout,*) "make contact list turn4",i," num_cont",
-c & num_cont_hb(i)
- call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
- enddo
- do ii=1,nat_sent
- i=iat_sent(ii)
-c write (iout,*) "make contact list longrange",i,ii," num_cont",
-c & num_cont_hb(i)
- do j=1,num_cont_hb(i)
- do k=1,4
- jjc=jcont_hb(j,i)
- iproc=iint_sent_local(k,jjc,ii)
-c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
- if (iproc.ne.0) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=i
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=d_cont(j,i)
- ind=3
- do kk=1,3
- ind=ind+1
- zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
- enddo
- enddo
- enddo
- enddo
- endif
- enddo
- enddo
- enddo
- if (lprn) then
- write (iout,*)
- & "Numbers of contacts to be sent to other processors",
- & (ncont_sent(i),i=1,ntask_cont_to)
- write (iout,*) "Contacts sent"
- do ii=1,ntask_cont_to
- nn=ncont_sent(ii)
- iproc=itask_cont_to(ii)
- write (iout,*) nn," contacts to processor",iproc,
- & " of CONT_TO_COMM group"
- do i=1,nn
- write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
- enddo
- enddo
- call flush(iout)
- endif
- CorrelType=477
- CorrelID=fg_rank+1
- CorrelType1=478
- CorrelID1=nfgtasks+fg_rank+1
- ireq=0
-C Receive the numbers of needed contacts from other processors
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- ireq=ireq+1
- call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
- & FG_COMM,req(ireq),IERR)
- enddo
-c write (iout,*) "IRECV ended"
-c call flush(iout)
-C Send the number of contacts needed by other processors
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- ireq=ireq+1
- call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
- & FG_COMM,req(ireq),IERR)
- enddo
-c write (iout,*) "ISEND ended"
-c write (iout,*) "number of requests (nn)",ireq
- call flush(iout)
- if (ireq.gt.0)
- & call MPI_Waitall(ireq,req,status_array,ierr)
-c write (iout,*)
-c & "Numbers of contacts to be received from other processors",
-c & (ncont_recv(i),i=1,ntask_cont_from)
-c call flush(iout)
-C Receive contacts
- ireq=0
- do ii=1,ntask_cont_from
- iproc=itask_cont_from(ii)
- nn=ncont_recv(ii)
-c write (iout,*) "Receiving",nn," contacts from processor",iproc,
-c & " of CONT_TO_COMM group"
- call flush(iout)
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
- & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-c write (iout,*) "ireq,req",ireq,req(ireq)
- endif
- enddo
-C Send the contacts to processors that need them
- do ii=1,ntask_cont_to
- iproc=itask_cont_to(ii)
- nn=ncont_sent(ii)
-c write (iout,*) nn," contacts to processor",iproc,
-c & " of CONT_TO_COMM group"
- if (nn.gt.0) then
- ireq=ireq+1
- call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
- & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
-c write (iout,*) "ireq,req",ireq,req(ireq)
-c do i=1,nn
-c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
-c enddo
- endif
- enddo
-c write (iout,*) "number of requests (contacts)",ireq
-c write (iout,*) "req",(req(i),i=1,4)
-c call flush(iout)
- if (ireq.gt.0)
- & call MPI_Waitall(ireq,req,status_array,ierr)
- do iii=1,ntask_cont_from
- iproc=itask_cont_from(iii)
- nn=ncont_recv(iii)
- if (lprn) then
- write (iout,*) "Received",nn," contacts from processor",iproc,
- & " of CONT_FROM_COMM group"
- call flush(iout)
- do i=1,nn
- write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
- enddo
- call flush(iout)
- endif
- do i=1,nn
- ii=zapas_recv(1,i,iii)
-c Flag the received contacts to prevent double-counting
- jj=-zapas_recv(2,i,iii)
-c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
-c call flush(iout)
- nnn=num_cont_hb(ii)+1
- num_cont_hb(ii)=nnn
- jcont_hb(nnn,ii)=jj
- d_cont(nnn,ii)=zapas_recv(3,i,iii)
- ind=3
- do kk=1,3
- ind=ind+1
- grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
- enddo
- enddo
- enddo
- enddo
- enddo
- enddo
- call flush(iout)
- if (lprn) then
- write (iout,'(a)') 'Contact function values after receive:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i3,5f6.3))')
- & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
- & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
- enddo
- call flush(iout)
- endif
- 30 continue
-#endif
- if (lprn) then
- write (iout,'(a)') 'Contact function values:'
- do i=nnt,nct-2
- write (iout,'(2i3,50(1x,i2,5f6.3))')
- & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
- & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
- enddo
- endif
- ecorr=0.0D0
- ecorr5=0.0d0
- ecorr6=0.0d0
-C Remove the loop below after debugging !!!
- do i=nnt,nct
- do j=1,3
- gradcorr(j,i)=0.0D0
- gradxorr(j,i)=0.0D0
- enddo
- enddo
-C Calculate the dipole-dipole interaction energies
- if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
- do i=iatel_s,iatel_e+1
- num_conti=num_cont_hb(i)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
-#ifdef MOMENT
- call dipole(i,j,jj)
-#endif
- enddo
- enddo
- endif
-C Calculate the local-electrostatic correlation terms
-c write (iout,*) "gradcorr5 in eello5 before loop"
-c do iii=1,nres
-c write (iout,'(i5,3f10.5)')
-c & iii,(gradcorr5(jjj,iii),jjj=1,3)
-c enddo
- do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
-c write (iout,*) "corr loop i",i
- i1=i+1
- num_conti=num_cont_hb(i)
- num_conti1=num_cont_hb(i+1)
- do jj=1,num_conti
- j=jcont_hb(jj,i)
- jp=iabs(j)
- do kk=1,num_conti1
- j1=jcont_hb(kk,i1)
- jp1=iabs(j1)
-c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
-c & ' jj=',jj,' kk=',kk
-c if (j1.eq.j+1 .or. j1.eq.j-1) then
- if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
- & .or. j.lt.0 .and. j1.gt.0) .and.
- & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
-C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
-C The system gains extra energy.
- n_corr=n_corr+1
- sqd1=dsqrt(d_cont(jj,i))
- sqd2=dsqrt(d_cont(kk,i1))
- sred_geom = sqd1*sqd2
- IF (sred_geom.lt.cutoff_corr) THEN
- call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
- & ekont,fprimcont)
-cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
-cd & ' jj=',jj,' kk=',kk
- fac_prim1=0.5d0*sqd2/sqd1*fprimcont
- fac_prim2=0.5d0*sqd1/sqd2*fprimcont
- do l=1,3
- g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
- g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
- enddo
- n_corr1=n_corr1+1
-cd write (iout,*) 'sred_geom=',sred_geom,
-cd & ' ekont=',ekont,' fprim=',fprimcont,
-cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
-cd write (iout,*) "g_contij",g_contij
-cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
-cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
- call calc_eello(i,jp,i+1,jp1,jj,kk)
- if (wcorr4.gt.0.0d0)
- & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
- if (energy_dec.and.wcorr4.gt.0.0d0)
- 1 write (iout,'(a6,4i5,0pf7.3)')
- 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
-c write (iout,*) "gradcorr5 before eello5"
-c do iii=1,nres
-c write (iout,'(i5,3f10.5)')
-c & iii,(gradcorr5(jjj,iii),jjj=1,3)
-c enddo
- if (wcorr5.gt.0.0d0)
- & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
-c write (iout,*) "gradcorr5 after eello5"
-c do iii=1,nres
-c write (iout,'(i5,3f10.5)')
-c & iii,(gradcorr5(jjj,iii),jjj=1,3)
-c enddo
- if (energy_dec.and.wcorr5.gt.0.0d0)
- 1 write (iout,'(a6,4i5,0pf7.3)')
- 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
-cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
-cd write(2,*)'ijkl',i,jp,i+1,jp1
- if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
- & .or. wturn6.eq.0.0d0))then
-cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
- ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
- if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
- 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
-cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
-cd & 'ecorr6=',ecorr6
-cd write (iout,'(4e15.5)') sred_geom,
-cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
-cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
-cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
- else if (wturn6.gt.0.0d0
- & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
-cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
- eturn6=eturn6+eello_turn6(i,jj,kk)
- if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
- 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
-cd write (2,*) 'multibody_eello:eturn6',eturn6
- endif
- ENDIF
-1111 continue
- endif
- enddo ! kk
- enddo ! jj
- enddo ! i
- do i=1,nres
- num_cont_hb(i)=num_cont_hb_old(i)
- enddo
-c write (iout,*) "gradcorr5 in eello5"
-c do iii=1,nres
-c write (iout,'(i5,3f10.5)')
-c & iii,(gradcorr5(jjj,iii),jjj=1,3)
-c enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine add_hb_contact_eello(ii,jj,itask)
- implicit real*8 (a-h,o-z)
- include "DIMENSIONS"
- include "COMMON.IOUNITS"
- integer max_cont
- integer max_dim
- parameter (max_cont=maxconts)
- parameter (max_dim=70)
- include "COMMON.CONTACTS"
- double precision zapas(max_dim,maxconts,max_fg_procs),
- & zapas_recv(max_dim,maxconts,max_fg_procs)
- common /przechowalnia/ zapas
- integer i,j,ii,jj,iproc,itask(4),nn
-c write (iout,*) "itask",itask
- do i=1,2
- iproc=itask(i)
- if (iproc.gt.0) then
- do j=1,num_cont_hb(ii)
- jjc=jcont_hb(j,ii)
-c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
- if (jjc.eq.jj) then
- ncont_sent(iproc)=ncont_sent(iproc)+1
- nn=ncont_sent(iproc)
- zapas(1,nn,iproc)=ii
- zapas(2,nn,iproc)=jjc
- zapas(3,nn,iproc)=d_cont(j,ii)
- ind=3
- do kk=1,3
- ind=ind+1
- zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
- enddo
- do kk=1,2
- do ll=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
- enddo
- enddo
- do jj=1,5
- do kk=1,3
- do ll=1,2
- do mm=1,2
- ind=ind+1
- zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
- enddo
- enddo
- enddo
- enddo
- exit
- endif
- enddo
- endif
- enddo
- return
- end
-c------------------------------------------------------------------------------
- double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- double precision gx(3),gx1(3)
- logical lprn
- lprn=.false.
- eij=facont_hb(jj,i)
- ekl=facont_hb(kk,k)
- ees0pij=ees0p(jj,i)
- ees0pkl=ees0p(kk,k)
- ees0mij=ees0m(jj,i)
- ees0mkl=ees0m(kk,k)
- ekont=eij*ekl
- ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
-cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
-C Following 4 lines for diagnostics.
-cd ees0pkl=0.0D0
-cd ees0pij=1.0D0
-cd ees0mkl=0.0D0
-cd ees0mij=1.0D0
-c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
-c & 'Contacts ',i,j,
-c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
-c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
-c & 'gradcorr_long'
-C Calculate the multi-body contribution to energy.
-c ecorr=ecorr+ekont*ees
-C Calculate multi-body contributions to the gradient.
- coeffpees0pij=coeffp*ees0pij
- coeffmees0mij=coeffm*ees0mij
- coeffpees0pkl=coeffp*ees0pkl
- coeffmees0mkl=coeffm*ees0mkl
- do ll=1,3
-cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
- gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
- & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
- & coeffmees0mkl*gacontm_hb1(ll,jj,i))
- gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
- & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
- & coeffmees0mkl*gacontm_hb2(ll,jj,i))
-cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
- gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
- & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
- & coeffmees0mij*gacontm_hb1(ll,kk,k))
- gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
- & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
- & coeffmees0mij*gacontm_hb2(ll,kk,k))
- gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
- & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
- & coeffmees0mkl*gacontm_hb3(ll,jj,i))
- gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
- gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
- gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
- & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
- & coeffmees0mij*gacontm_hb3(ll,kk,k))
- gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
- gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
-c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
- enddo
-c write (iout,*)
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+
-cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
-cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
-cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+
-cgrad & ees*eij*gacont_hbr(ll,kk,k)-
-cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
-cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
-cgrad enddo
-cgrad enddo
-c write (iout,*) "ehbcorr",ekont*ees
- ehbcorr=ekont*ees
- return
- end
-#ifdef MOMENT
-C---------------------------------------------------------------------------
- subroutine dipole(i,j,jj)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
- & auxmat(2,2)
- iti1 = itortyp(itype(i+1))
- if (j.lt.nres-1) then
- itj1 = itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
- do iii=1,2
- dipi(iii,1)=Ub2(iii,i)
- dipderi(iii)=Ub2der(iii,i)
- dipi(iii,2)=b1(iii,iti1)
- dipj(iii,1)=Ub2(iii,j)
- dipderj(iii)=Ub2der(iii,j)
- dipj(iii,2)=b1(iii,itj1)
- enddo
- kkk=0
- do iii=1,2
- call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
- do jjj=1,2
- kkk=kkk+1
- dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
- enddo
- enddo
- do kkk=1,5
- do lll=1,3
- mmm=0
- do iii=1,2
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
- & auxvec(1))
- do jjj=1,2
- mmm=mmm+1
- dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
- enddo
- enddo
- enddo
- enddo
- call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
- call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
- do iii=1,2
- dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
- enddo
- call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
- do iii=1,2
- dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
- enddo
- return
- end
-#endif
-C---------------------------------------------------------------------------
- subroutine calc_eello(i,j,k,l,jj,kk)
-C
-C This subroutine computes matrices and vectors needed to calculate
-C the fourth-, fifth-, and sixth-order local-electrostatic terms.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
- & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
- logical lprn
- common /kutas/ lprn
-cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
-cd & ' jj=',jj,' kk=',kk
-cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
-cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
-cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
- do iii=1,2
- do jjj=1,2
- aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
- aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
- enddo
- enddo
- call transpose2(aa1(1,1),aa1t(1,1))
- call transpose2(aa2(1,1),aa2t(1,1))
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
- & aa1tder(1,1,lll,kkk))
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
- & aa2tder(1,1,lll,kkk))
- enddo
- enddo
- if (l.eq.j+1) then
-C parallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
- iti=itortyp(itype(i))
- else
- iti=ntortyp+1
- endif
- itk1=itortyp(itype(k+1))
- itj=itortyp(itype(j))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
- else
- itl1=ntortyp+1
- endif
-C A1 kernel(j+1) A2T
-cd do iii=1,2
-cd write (iout,'(3f10.5,5x,3f10.5)')
-cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
-cd enddo
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
- & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
- & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
- & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
- & ADtEAderx(1,1,1,1,1,1))
- lprn=.false.
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
- & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
- & ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-C End 6-th order cumulants
-cd lprn=.false.
-cd if (lprn) then
-cd write (2,*) 'In calc_eello6'
-cd do iii=1,2
-cd write (2,*) 'iii=',iii
-cd do kkk=1,5
-cd write (2,*) 'kkk=',kkk
-cd do jjj=1,2
-cd write (2,'(3(2f10.5),5x)')
-cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
-cd enddo
-cd enddo
-cd enddo
-cd endif
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
- & EAEAderx(1,1,lll,kkk,iii,1))
- enddo
- enddo
- enddo
-C A1T kernel(i+1) A2
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
- & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0) THEN
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
- & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
- & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
- & ADtEAderx(1,1,1,1,1,2))
- call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
- & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
- & ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-C End 6-th order cumulants
- call transpose2(EUgder(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & EAEAderx(1,1,lll,kkk,iii,2))
- enddo
- enddo
- enddo
-C AEAb1 and AEAb2
-C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-C They are needed only when the fifth- or the sixth-order cumulants are
-C indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
-C Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),
- & AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),
- & AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
- & AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
- & AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj),
- & AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,j),
- & AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
- & AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
- & AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
- enddo
- ENDIF
-C End vectors
- else
-C Antiparallel orientation of the two CA-CA-CA frames.
- if (i.gt.1) then
- iti=itortyp(itype(i))
- else
- iti=ntortyp+1
- endif
- itk1=itortyp(itype(k+1))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
-C A2 kernel(j-1)T A1T
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
- & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
- & j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
- & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
- call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
- & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
- & ADtEAderx(1,1,1,1,1,1))
- call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
- & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
- & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
- & ADtEA1derx(1,1,1,1,1,1))
- ENDIF
-C End 6-th order cumulants
- call transpose2(EUgder(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
- & EAEAderx(1,1,lll,kkk,iii,1))
- enddo
- enddo
- enddo
-C A2T kernel(i+1)T A1
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
- & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
-C Following matrices are needed only for 6-th order cumulants
- IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
- & j.eq.i+4 .and. l.eq.i+3)) THEN
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
- & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
- & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
- & ADtEAderx(1,1,1,1,1,2))
- call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
- & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
- & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
- & ADtEA1derx(1,1,1,1,1,2))
- ENDIF
-C End 6-th order cumulants
- call transpose2(EUgder(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & EAEAderx(1,1,lll,kkk,iii,2))
- enddo
- enddo
- enddo
-C AEAb1 and AEAb2
-C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
-C They are needed only when the fifth- or the sixth-order cumulants are
-C indluded.
- IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
- & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
- call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
- call transpose2(AEAderg(1,1,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
- call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
- call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
- call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
- call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
- call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
- call transpose2(AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
- call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
- call transpose2(AEAderg(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
- call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
- call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
- call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
- call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
- call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
-C Calculate the Cartesian derivatives of the vectors.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,iti),
- & AEAb1derx(1,lll,kkk,iii,1,1))
- call matvec2(auxmat(1,1),Ub2(1,i),
- & AEAb2derx(1,lll,kkk,iii,1,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
- & AEAb1derx(1,lll,kkk,iii,2,1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
- & AEAb2derx(1,lll,kkk,iii,2,1))
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
- call matvec2(auxmat(1,1),b1(1,itl),
- & AEAb1derx(1,lll,kkk,iii,1,2))
- call matvec2(auxmat(1,1),Ub2(1,l),
- & AEAb2derx(1,lll,kkk,iii,1,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
- & AEAb1derx(1,lll,kkk,iii,2,2))
- call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
- & AEAb2derx(1,lll,kkk,iii,2,2))
- enddo
- enddo
- enddo
- ENDIF
-C End vectors
- endif
- return
- end
-C---------------------------------------------------------------------------
- subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
- & KK,KKderg,AKA,AKAderg,AKAderx)
- implicit none
- integer nderg
- logical transp
- double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
- & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
- & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
- integer iii,kkk,lll
- integer jjj,mmm
- logical lprn
- common /kutas/ lprn
- call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
- do iii=1,nderg
- call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
- & AKAderg(1,1,iii))
- enddo
-cd if (lprn) write (2,*) 'In kernel'
- do kkk=1,5
-cd if (lprn) write (2,*) 'kkk=',kkk
- do lll=1,3
- call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
- & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
-cd if (lprn) then
-cd write (2,*) 'lll=',lll
-cd write (2,*) 'iii=1'
-cd do jjj=1,2
-cd write (2,'(3(2f10.5),5x)')
-cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
-cd enddo
-cd endif
- call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
- & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
-cd if (lprn) then
-cd write (2,*) 'lll=',lll
-cd write (2,*) 'iii=2'
-cd do jjj=1,2
-cd write (2,'(3(2f10.5),5x)')
-cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
-cd enddo
-cd endif
- enddo
- enddo
- return
- end
-C---------------------------------------------------------------------------
- double precision function eello4(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision pizda(2,2),ggg1(3),ggg2(3)
-cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
-cd eello4=0.0d0
-cd return
-cd endif
-cd print *,'eello4:',i,j,k,l,jj,kk
-cd write (2,*) 'i',i,' j',j,' k',k,' l',l
-cd call checkint4(i,j,k,l,jj,kk,eel4_num)
-cold eij=facont_hb(jj,i)
-cold ekl=facont_hb(kk,k)
-cold ekont=eij*ekl
- eel4=-EAEA(1,1,1)-EAEA(2,2,1)
-cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
- gcorr_loc(k-1)=gcorr_loc(k-1)
- & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
- if (l.eq.j+1) then
- gcorr_loc(l-1)=gcorr_loc(l-1)
- & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- else
- gcorr_loc(j-1)=gcorr_loc(j-1)
- & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
- endif
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
- & -EAEAderx(2,2,lll,kkk,iii,1)
-cd derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd gcorr_loc(l-1)=0.0d0
-cd gcorr_loc(j-1)=0.0d0
-cd gcorr_loc(k-1)=0.0d0
-cd eel4=1.0d0
-cd write (iout,*)'Contacts have occurred for peptide groups',
-cd & i,j,' fcont:',eij,' eij',' and ',k,l,
-cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
-cgrad ggg1(ll)=eel4*g_contij(ll,1)
-cgrad ggg2(ll)=eel4*g_contij(ll,2)
- glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
- glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
-cgrad ghalf=0.5d0*ggg1(ll)
- gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
- gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
- gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
- gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
- gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
-cgrad ghalf=0.5d0*ggg2(ll)
- gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
- gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
- gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
- gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
- gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
- enddo
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=i+2,j2
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+2,l2
-cgrad do ll=1,3
-cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
-cgrad enddo
-cgrad enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,gcorr_loc(iii)
-cd enddo
- eello4=ekont*eel4
-cd write (2,*) 'ekont',ekont
-cd write (iout,*) 'eello4',ekont*eel4
- return
- end
-C---------------------------------------------------------------------------
- double precision function eello5(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
- double precision ggg1(3),ggg2(3)
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel chains C
-C C
-C o o o o C
-C /l\ / \ \ / \ / \ / C
-C / \ / \ \ / \ / \ / C
-C j| o |l1 | o | o| o | | o |o C
-C \ |/k\| |/ \| / |/ \| |/ \| C
-C \i/ \ / \ / / \ / \ C
-C o k1 o C
-C (I) (II) (III) (IV) C
-C C
-C eello5_1 eello5_2 eello5_3 eello5_4 C
-C C
-C Antiparallel chains C
-C C
-C o o o o C
-C /j\ / \ \ / \ / \ / C
-C / \ / \ \ / \ / \ / C
-C j1| o |l | o | o| o | | o |o C
-C \ |/k\| |/ \| / |/ \| |/ \| C
-C \i/ \ / \ / / \ / \ C
-C o k1 o C
-C (I) (II) (III) (IV) C
-C C
-C eello5_1 eello5_2 eello5_3 eello5_4 C
-C C
-C o denotes a local interaction, vertical lines an electrostatic interaction. C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
-cd eello5=0.0d0
-cd return
-cd endif
-cd write (iout,*)
-cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
-cd & ' and',k,l
- itk=itortyp(itype(k))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
- eello5_1=0.0d0
- eello5_2=0.0d0
- eello5_3=0.0d0
- eello5_4=0.0d0
-cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
-cd & eel5_3_num,eel5_4_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd eij=facont_hb(jj,i)
-cd ekl=facont_hb(kk,k)
-cd ekont=eij*ekl
-cd write (iout,*)'Contacts have occurred for peptide groups',
-cd & i,j,' fcont:',eij,' eij',' and ',k,l
-cd goto 1111
-C Contribution from the graph I.
-cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
-cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
-C Explicit gradient in virtual-dihedral angles.
- if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
- & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- if (l.eq.j+1) then
- if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- else
- if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
- endif
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
- enddo
- enddo
- enddo
-c goto 1112
-c1111 continue
-C Contribution from graph II
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
- call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- if (l.eq.j+1) then
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- else
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
- endif
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
- & -0.5d0*scalar2(vv(1),Ctobr(1,k))
- enddo
- enddo
- enddo
-cd goto 1112
-cd1111 continue
- if (l.eq.j+1) then
-cd goto 1110
-C Parallel orientation
-C Contribution from graph III
- call transpose2(EUg(1,1,l),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
- call transpose2(EUgder(1,1,l),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
- enddo
- enddo
- enddo
-cd goto 1112
-C Contribution from graph IV
-cd1110 continue
- call transpose2(EE(1,1,itl),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
- & -0.5d0*scalar2(vv(1),Ctobr(1,l))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
- & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,iii)=derx(lll,kkk,iii)
- & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
- & -0.5d0*scalar2(vv(1),Ctobr(1,l))
- enddo
- enddo
- enddo
- else
-C Antiparallel orientation
-C Contribution from graph III
-c goto 1110
- call transpose2(EUg(1,1,j),auxmat(1,1))
- call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(l-1)=g_corr5_loc(l-1)
- & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
- call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
- call transpose2(EUgder(1,1,j),auxmat1(1,1))
- call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
- & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
- & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
- enddo
- enddo
- enddo
-cd goto 1112
-C Contribution from graph IV
-1110 continue
- call transpose2(EE(1,1,itj),auxmat(1,1))
- call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
- & -0.5d0*scalar2(vv(1),Ctobr(1,j))
-C Explicit gradient in virtual-dihedral angles.
- g_corr5_loc(j-1)=g_corr5_loc(j-1)
- & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
- call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- g_corr5_loc(k-1)=g_corr5_loc(k-1)
- & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
- & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
-C Cartesian gradient
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
- & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
- & -0.5d0*scalar2(vv(1),Ctobr(1,j))
- enddo
- enddo
- enddo
- endif
-1112 continue
- eel5=eello5_1+eello5_2+eello5_3+eello5_4
-cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
-cd write (2,*) 'ijkl',i,j,k,l
-cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
-cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
-cd endif
-cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
-cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
-cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
-cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
-cd eij=1.0d0
-cd ekl=1.0d0
-cd ekont=1.0d0
-cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
-C 2/11/08 AL Gradients over DC's connecting interacting sites will be
-C summed up outside the subrouine as for the other subroutines
-C handling long-range interactions. The old code is commented out
-C with "cgrad" to keep track of changes.
- do ll=1,3
-cgrad ggg1(ll)=eel5*g_contij(ll,1)
-cgrad ggg2(ll)=eel5*g_contij(ll,2)
- gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
- gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
-c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
-c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
-c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
-c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
-c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
-c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
-c & gradcorr5ij,
-c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
-cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
-cgrad ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
- gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
- gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
- gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
- gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
-cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
-cgrad ghalf=0.5d0*ggg2(ll)
-cd ghalf=0.0d0
- gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
- gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
- gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
- gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
- gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
- enddo
-cd goto 1112
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
-cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
-cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
-cgrad enddo
-cgrad enddo
-c1112 continue
-cgrad do m=i+2,j2
-cgrad do ll=1,3
-cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+2,l2
-cgrad do ll=1,3
-cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
-cgrad enddo
-cgrad enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,g_corr5_loc(iii)
-cd enddo
- eello5=ekont*eel5
-cd write (2,*) 'ekont',ekont
-cd write (iout,*) 'eello5',ekont*eel5
- return
- end
-c--------------------------------------------------------------------------
- double precision function eello6(i,j,k,l,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- double precision ggg1(3),ggg2(3)
-cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-cd eello6=0.0d0
-cd return
-cd endif
-cd write (iout,*)
-cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-cd & ' and',k,l
- eello6_1=0.0d0
- eello6_2=0.0d0
- eello6_3=0.0d0
- eello6_4=0.0d0
- eello6_5=0.0d0
- eello6_6=0.0d0
-cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
-cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd eij=facont_hb(jj,i)
-cd ekl=facont_hb(kk,k)
-cd ekont=eij*ekl
-cd eij=1.0d0
-cd ekl=1.0d0
-cd ekont=1.0d0
- if (l.eq.j+1) then
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(j,i,l,k,2,.false.)
- eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
- eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
- else
- eello6_1=eello6_graph1(i,j,k,l,1,.false.)
- eello6_2=eello6_graph1(l,k,j,i,2,.true.)
- eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
- eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
- if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
- else
- eello6_5=0.0d0
- endif
- eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
- endif
-C If turn contributions are considered, they will be handled separately.
- eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
-cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
-cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
-cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
-cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
-cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
-cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
-cd goto 1112
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
-cgrad ggg1(ll)=eel6*g_contij(ll,1)
-cgrad ggg2(ll)=eel6*g_contij(ll,2)
-cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
-cgrad ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
- gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
- gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
- gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
- gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
- gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
- gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
- gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
-cgrad ghalf=0.5d0*ggg2(ll)
-cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
-cd ghalf=0.0d0
- gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
- gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
- gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
- gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
- gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
- enddo
-cd goto 1112
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
-cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
-cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
-cgrad enddo
-cgrad enddo
-cgrad1112 continue
-cgrad do m=i+2,j2
-cgrad do ll=1,3
-cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+2,l2
-cgrad do ll=1,3
-cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
-cgrad enddo
-cgrad enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,g_corr6_loc(iii)
-cd enddo
- eello6=ekont*eel6
-cd write (2,*) 'ekont',ekont
-cd write (iout,*) 'eello6',ekont*eel6
- return
- end
-c--------------------------------------------------------------------------
- double precision function eello6_graph1(i,j,k,l,imat,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
- logical swap
- logical lprn
- common /kutas/ lprn
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C Parallel Antiparallel
-C
-C o o
-C /l\ /j\
-C / \ / \
-C /| o | | o |\
-C \ j|/k\| / \ |/k\|l /
-C \ / \ / \ / \ /
-C o o o o
-C i i
-C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- itk=itortyp(itype(k))
- s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
- eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
- if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
- & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
- & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
- & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
- & +scalar2(vv(1),Dtobr2der(1,i)))
- call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
- vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
- if (l.eq.j+1) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1)
- & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
- & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
- & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)
- & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
- & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
- & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
- endif
- call transpose2(EUgCder(1,1,k),auxmat(1,1))
- call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
- & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
- & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
- & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
- do iii=1,2
- if (swap) then
- ind=3-iii
- else
- ind=iii
- endif
- do kkk=1,5
- do lll=1,3
- s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
- s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
- s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
- call transpose2(EUgC(1,1,k),auxmat(1,1))
- call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
- & pizda1(1,1))
- vv1(1)=pizda1(1,1)-pizda1(2,2)
- vv1(2)=pizda1(1,2)+pizda1(2,1)
- s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
- vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
- & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
- vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
- & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
- s5=scalar2(vv(1),Dtobr2(1,i))
- derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- logical swap
- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
- & auxvec1(2),auxvec2(2),auxmat1(2,2)
- logical lprn
- common /kutas/ lprn
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C \ /l\ /j\ / C
-C \ / \ / \ / C
-C o| o | | o |o C
-C \ j|/k\| \ |/k\|l C
-C \ / \ \ / \ C
-C o o C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
-C AL 7/4/01 s1 would occur in the sixth-order moment,
-C but not in a cluster cumulant
-#ifdef MOMENT
- s1=dip(1,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph2=-(s1+s2+s3+s4)
-#else
- eello6_graph2=-(s2+s3+s4)
-#endif
-c eello6_graph2=-s3
-C Derivatives in gamma(i-1)
- if (i.gt.1) then
-#ifdef MOMENT
- s1=dipderg(1,jj,i)*dip(1,kk,k)
-#endif
- s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
-#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
-#endif
-c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
- endif
-C Derivatives in gamma(k-1)
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(1,kk,k)
-#endif
- call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
-#endif
-c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
-C Derivatives in gamma(j-1) or gamma(l-1)
- if (j.gt.1) then
-#ifdef MOMENT
- s1=dipderg(3,jj,i)*dip(1,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
- call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
- endif
-#endif
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
-c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
- endif
-C Derivatives in gamma(l-1) or gamma(j-1)
- if (l.gt.1) then
-#ifdef MOMENT
- s1=dip(1,jj,i)*dipderg(3,kk,k)
-#endif
- call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
- call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
- call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-#ifdef MOMENT
- if (swap) then
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
- else
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
- endif
-#endif
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
-c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
- endif
-C Cartesian derivatives.
- if (lprn) then
- write (2,*) 'In eello6_graph2'
- do iii=1,2
- write (2,*) 'iii=',iii
- do kkk=1,5
- write (2,*) 'kkk=',kkk
- do jjj=1,2
- write (2,'(3(2f10.5),5x)')
- & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
- enddo
- enddo
- enddo
- endif
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
- else
- s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
- endif
-#endif
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
- & auxvec(1))
- s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
- & auxvec(1))
- s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(1,2)+pizda(2,1)
- s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
- logical swap
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C /l\ / \ /j\ C
-C / \ / \ / \ C
-C /| o |o o| o |\ C
-C j|/k\| / |/k\|l / C
-C / \ / / \ / C
-C / o / o C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C 4/7/01 AL Component s1 was removed, because it pertains to the respective
-C energy moment and not to the cluster cumulant.
- iti=itortyp(itype(i))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
- itk=itortyp(itype(k))
- itk1=itortyp(itype(k+1))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
- else
- itl1=ntortyp+1
- endif
-#ifdef MOMENT
- s1=dip(4,jj,i)*dip(4,kk,k)
-#endif
- call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call transpose2(EE(1,1,itk),auxmat(1,1))
- call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
-cd & "sum",-(s2+s3+s4)
-#ifdef MOMENT
- eello6_graph3=-(s1+s2+s3+s4)
-#else
- eello6_graph3=-(s2+s3+s4)
-#endif
-c eello6_graph3=-s4
-C Derivatives in gamma(k-1)
- call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
-C Derivatives in gamma(l-1)
- call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
-C Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
- else
- s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
- endif
-#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
- & auxvec(1))
- s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
- call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
- & auxvec(1))
- s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
- call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)+pizda(2,2)
- vv(2)=pizda(2,1)-pizda(1,2)
- s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (swap) then
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
-c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
- & auxvec1(2),auxmat1(2,2)
- logical swap
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C Parallel Antiparallel C
-C C
-C o o C
-C /l\ / \ /j\ C
-C / \ / \ / \ C
-C /| o |o o| o |\ C
-C \ j|/k\| \ |/k\|l C
-C \ / \ \ / \ C
-C o \ o \ C
-C i i C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C
-C 4/7/01 AL Component s1 was removed, because it pertains to the respective
-C energy moment and not to the cluster cumulant.
-cd write (2,*) 'eello_graph4: wturn6',wturn6
- iti=itortyp(itype(i))
- itj=itortyp(itype(j))
- if (j.lt.nres-1) then
- itj1=itortyp(itype(j+1))
- else
- itj1=ntortyp+1
- endif
- itk=itortyp(itype(k))
- if (k.lt.nres-1) then
- itk1=itortyp(itype(k+1))
- else
- itk1=ntortyp+1
- endif
- itl=itortyp(itype(l))
- if (l.lt.nres-1) then
- itl1=itortyp(itype(l+1))
- else
- itl1=ntortyp+1
- endif
-cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
-cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
-cd & ' itl',itl,' itl1',itl1
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dip(3,kk,k)
- else
- s1=dip(2,jj,j)*dip(2,kk,l)
- endif
-#endif
- call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- call transpose2(EUg(1,1,k),auxmat(1,1))
- call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
-cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
-#ifdef MOMENT
- eello6_graph4=-(s1+s2+s3+s4)
-#else
- eello6_graph4=-(s2+s3+s4)
-#endif
-C Derivatives in gamma(i-1)
- if (i.gt.1) then
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dipderg(2,jj,i)*dip(3,kk,k)
- else
- s1=dipderg(4,jj,j)*dip(2,kk,l)
- endif
-#endif
- s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-cd write (2,*) 'turn6 derivatives'
-#ifdef MOMENT
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
-#else
- gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
-#endif
- else
-#ifdef MOMENT
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
-#endif
- endif
- endif
-C Derivatives in gamma(k-1)
-#ifdef MOMENT
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderg(2,kk,k)
- else
- s1=dip(2,jj,j)*dipderg(4,kk,l)
- endif
-#endif
- call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
- else
- call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
- endif
- call transpose2(EUgder(1,1,k),auxmat1(1,1))
- call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-#ifdef MOMENT
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
-#else
- gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
-#endif
- else
-#ifdef MOMENT
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
-#else
- g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
-#endif
- endif
-C Derivatives in gamma(j-1) or gamma(l-1)
- if (l.eq.j+1 .and. l.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
- else if (j.gt.1) then
- call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
- gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
- else
- g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
- endif
- endif
-C Cartesian derivatives.
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- if (iii.eq.1) then
- if (imat.eq.1) then
- s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
- else
- s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
- endif
- else
- if (imat.eq.1) then
- s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
- else
- s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
- endif
- endif
-#endif
- call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
- & auxvec(1))
- s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
- if (j.eq.l+1) then
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
- & b1(1,itj1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
- else
- call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
- & b1(1,itl1),auxvec(1))
- s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
- endif
- call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
- & pizda(1,1))
- vv(1)=pizda(1,1)-pizda(2,2)
- vv(2)=pizda(2,1)+pizda(1,2)
- s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
- if (swap) then
- if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
-#ifdef MOMENT
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
- & -(s1+s2+s4)
-#else
- derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
- & -(s2+s4)
-#endif
- derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
- else
-#ifdef MOMENT
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
-#endif
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- endif
- else
-#ifdef MOMENT
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
-#else
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
-#endif
- if (l.eq.j+1) then
- derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
- else
- derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
- endif
- endif
- enddo
- enddo
- enddo
- return
- end
-c----------------------------------------------------------------------------
- double precision function eello_turn6(i,jj,kk)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORSION'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
- & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
- & ggg1(3),ggg2(3)
- double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
- & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
-C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
-C the respective energy moment and not to the cluster cumulant.
- s1=0.0d0
- s8=0.0d0
- s13=0.0d0
-c
- eello_turn6=0.0d0
- j=i+4
- k=i+1
- l=i+3
- iti=itortyp(itype(i))
- itk=itortyp(itype(k))
- itk1=itortyp(itype(k+1))
- itl=itortyp(itype(l))
- itj=itortyp(itype(j))
-cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
-cd write (2,*) 'i',i,' k',k,' j',j,' l',l
-cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
-cd eello6=0.0d0
-cd return
-cd endif
-cd write (iout,*)
-cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
-cd & ' and',k,l
-cd call checkint_turn6(i,jj,kk,eel_turn6_num)
- do iii=1,2
- do kkk=1,5
- do lll=1,3
- derx_turn(lll,kkk,iii)=0.0d0
- enddo
- enddo
- enddo
-cd eij=1.0d0
-cd ekl=1.0d0
-cd ekont=1.0d0
- eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
-cd eello6_5=0.0d0
-cd write (2,*) 'eello6_5',eello6_5
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmat(1,1))
- call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
- ss1=scalar2(Ub2(1,i+2),b1(1,itl))
- s1 = (auxmat(1,1)+auxmat(2,2))*ss1
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
- s2 = scalar2(b1(1,itk),vtemp1(1))
-#ifdef MOMENT
- call transpose2(AEA(1,1,2),atemp(1,1))
- call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
- call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
- s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
- call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
- s12 = scalar2(Ub2(1,i+2),vtemp3(1))
-#ifdef MOMENT
- call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
- call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
- call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
- ss13 = scalar2(b1(1,itk),vtemp4(1))
- s13 = (gtemp(1,1)+gtemp(2,2))*ss13
-#endif
-c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
-c s1=0.0d0
-c s2=0.0d0
-c s8=0.0d0
-c s12=0.0d0
-c s13=0.0d0
- eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
-C Derivatives in gamma(i+2)
- s1d =0.0d0
- s8d =0.0d0
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
- call transpose2(AEAderg(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
- gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
-C Derivatives in gamma(i+3)
-#ifdef MOMENT
- call transpose2(AEA(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
-#endif
- call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
- s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
-#endif
- s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
-#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
-#endif
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
- & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
-#else
- gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
- & -0.5d0*ekont*(s2d+s12d)
-#endif
-C Derivatives in gamma(i+4)
- call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-#ifdef MOMENT
- call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
- s13d = (gtempd(1,1)+gtempd(2,2))*ss13
-#endif
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-C s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
-#else
- gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
-#endif
-C Derivatives in gamma(i+5)
-#ifdef MOMENT
- call transpose2(AEAderg(1,1,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
- call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call transpose2(AEA(1,1,2),atempd(1,1))
- call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-#ifdef MOMENT
- call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
-#endif
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
- & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
-#else
- gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
- & -0.5d0*ekont*(s2d+s12d)
-#endif
-C Cartesian derivatives
- do iii=1,2
- do kkk=1,5
- do lll=1,3
-#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
- call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
- s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
-#endif
- call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
- call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
- & vtemp1d(1))
- s2d = scalar2(b1(1,itk),vtemp1d(1))
-#ifdef MOMENT
- call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
- call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
- s8d = -(atempd(1,1)+atempd(2,2))*
- & scalar2(cc(1,1,itl),vtemp2(1))
-#endif
- call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
- & auxmatd(1,1))
- call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
- s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
-c s1d=0.0d0
-c s2d=0.0d0
-c s8d=0.0d0
-c s12d=0.0d0
-c s13d=0.0d0
-#ifdef MOMENT
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
- & - 0.5d0*(s1d+s2d)
-#else
- derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
- & - 0.5d0*s2d
-#endif
-#ifdef MOMENT
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
- & - 0.5d0*(s8d+s12d)
-#else
- derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
- & - 0.5d0*s12d
-#endif
- enddo
- enddo
- enddo
-#ifdef MOMENT
- do kkk=1,5
- do lll=1,3
- call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
- & achuj_tempd(1,1))
- call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
- call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
- s13d=(gtempd(1,1)+gtempd(2,2))*ss13
- derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
- call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
- & vtemp4d(1))
- ss13d = scalar2(b1(1,itk),vtemp4d(1))
- s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
- derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
- enddo
- enddo
-#endif
-cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
-cd & 16*eel_turn6_num
-cd goto 1112
- if (j.lt.nres-1) then
- j1=j+1
- j2=j-1
- else
- j1=j-1
- j2=j-2
- endif
- if (l.lt.nres-1) then
- l1=l+1
- l2=l-1
- else
- l1=l-1
- l2=l-2
- endif
- do ll=1,3
-cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
-cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
-cgrad ghalf=0.5d0*ggg1(ll)
-cd ghalf=0.0d0
- gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
- gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
- gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
- & +ekont*derx_turn(ll,2,1)
- gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
- gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
- & +ekont*derx_turn(ll,4,1)
- gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
- gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
- gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
-cgrad ghalf=0.5d0*ggg2(ll)
-cd ghalf=0.0d0
- gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
- & +ekont*derx_turn(ll,2,2)
- gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
- gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
- & +ekont*derx_turn(ll,4,2)
- gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
- gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
- gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
- enddo
-cd goto 1112
-cgrad do m=i+1,j-1
-cgrad do ll=1,3
-cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+1,l-1
-cgrad do ll=1,3
-cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
-cgrad enddo
-cgrad enddo
-cgrad1112 continue
-cgrad do m=i+2,j2
-cgrad do ll=1,3
-cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
-cgrad enddo
-cgrad enddo
-cgrad do m=k+2,l2
-cgrad do ll=1,3
-cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
-cgrad enddo
-cgrad enddo
-cd do iii=1,nres-3
-cd write (2,*) iii,g_corr6_loc(iii)
-cd enddo
- eello_turn6=ekont*eel_turn6
-cd write (2,*) 'ekont',ekont
-cd write (2,*) 'eel_turn6',ekont*eel_turn6
- return
- end
-
-C-----------------------------------------------------------------------------
- double precision function scalar(u,v)
-!DIR$ INLINEALWAYS scalar
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::scalar
-#endif
- implicit none
- double precision u(3),v(3)
-cd double precision sc
-cd integer i
-cd sc=0.0d0
-cd do i=1,3
-cd sc=sc+u(i)*v(i)
-cd enddo
-cd scalar=sc
-
- scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
- return
- end
-crc-------------------------------------------------
- SUBROUTINE MATVEC2(A1,V1,V2)
-!DIR$ INLINEALWAYS MATVEC2
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
-#endif
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A1(2,2),V1(2),V2(2)
-c DO 1 I=1,2
-c VI=0.0
-c DO 3 K=1,2
-c 3 VI=VI+A1(I,K)*V1(K)
-c Vaux(I)=VI
-c 1 CONTINUE
-
- vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
- vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
-
- v2(1)=vaux1
- v2(2)=vaux2
- END
-C---------------------------------------
- SUBROUTINE MATMAT2(A1,A2,A3)
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
-#endif
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A1(2,2),A2(2,2),A3(2,2)
-c DIMENSION AI3(2,2)
-c DO J=1,2
-c A3IJ=0.0
-c DO K=1,2
-c A3IJ=A3IJ+A1(I,K)*A2(K,J)
-c enddo
-c A3(I,J)=A3IJ
-c enddo
-c enddo
-
- ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
- ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
- ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
- ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
-
- A3(1,1)=AI3_11
- A3(2,1)=AI3_21
- A3(1,2)=AI3_12
- A3(2,2)=AI3_22
- END
-
-c-------------------------------------------------------------------------
- double precision function scalar2(u,v)
-!DIR$ INLINEALWAYS scalar2
- implicit none
- double precision u(2),v(2)
- double precision sc
- integer i
- scalar2=u(1)*v(1)+u(2)*v(2)
- return
- end
-
-C-----------------------------------------------------------------------------
-
- subroutine transpose2(a,at)
-!DIR$ INLINEALWAYS transpose2
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::transpose2
-#endif
- implicit none
- double precision a(2,2),at(2,2)
- at(1,1)=a(1,1)
- at(1,2)=a(2,1)
- at(2,1)=a(1,2)
- at(2,2)=a(2,2)
- return
- end
-c--------------------------------------------------------------------------
- subroutine transpose(n,a,at)
- implicit none
- integer n,i,j
- double precision a(n,n),at(n,n)
- do i=1,n
- do j=1,n
- at(j,i)=a(i,j)
- enddo
- enddo
- return
- end
-C---------------------------------------------------------------------------
- subroutine prodmat3(a1,a2,kk,transp,prod)
-!DIR$ INLINEALWAYS prodmat3
-#ifndef OSF
-cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
-#endif
- implicit none
- integer i,j
- double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
- logical transp
-crc double precision auxmat(2,2),prod_(2,2)
-
- if (transp) then
-crc call transpose2(kk(1,1),auxmat(1,1))
-crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
-crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
- & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
- & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
- & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
- & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
-
- else
-crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
-crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
-
- prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
- & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
- prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
- & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
- prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
- & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
- prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
- & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
-
- endif
-c call transpose2(a2(1,1),a2t(1,1))
-
-crc print *,transp
-crc print *,((prod_(i,j),i=1,2),j=1,2)
-crc print *,((prod(i,j),i=1,2),j=1,2)
-
- return
- end
-
+++ /dev/null
- subroutine etotal_long(energia)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-c
-c Compute the long-range slow-varying contributions to the energy
-c
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include "mpif.h"
- double precision weights_(n_ene)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision energia(0:n_ene)
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.MD'
-c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
- if (modecalc.eq.12.or.modecalc.eq.14) then
-#ifdef MPI
-c if (fg_rank.eq.0) call int_from_cart1(.false.)
-#else
- call int_from_cart1(.false.)
-#endif
- endif
-#ifdef MPI
-c write(iout,*) "ETOTAL_LONG Processor",fg_rank,
-c & " absolute rank",myrank," nfgtasks",nfgtasks
- call flush(iout)
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-C FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (fg_rank.eq.0) then
- call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
-c write (iout,*) "Processor",myrank," BROADCAST iorder"
-c call flush(iout)
-C FG master sets up the WEIGHTS_ array which will be broadcast to the
-C FG slaves as WEIGHTS array.
- weights_(1)=wsc
- weights_(2)=wscp
- weights_(3)=welec
- weights_(4)=wcorr
- weights_(5)=wcorr5
- weights_(6)=wcorr6
- weights_(7)=wel_loc
- weights_(8)=wturn3
- weights_(9)=wturn4
- weights_(10)=wturn6
- weights_(11)=wang
- weights_(12)=wscloc
- weights_(13)=wtor
- weights_(14)=wtor_d
- weights_(15)=wstrain
- weights_(16)=wvdwpp
- weights_(17)=wbond
- weights_(18)=scal14
- weights_(21)=wsccor
-C FG Master broadcasts the WEIGHTS_ array
- call MPI_Bcast(weights_(1),n_ene,
- & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- else
-C FG slaves receive the WEIGHTS array
- call MPI_Bcast(weights(1),n_ene,
- & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- wsc=weights(1)
- wscp=weights(2)
- welec=weights(3)
- wcorr=weights(4)
- wcorr5=weights(5)
- wcorr6=weights(6)
- wel_loc=weights(7)
- wturn3=weights(8)
- wturn4=weights(9)
- wturn6=weights(10)
- wang=weights(11)
- wscloc=weights(12)
- wtor=weights(13)
- wtor_d=weights(14)
- wstrain=weights(15)
- wvdwpp=weights(16)
- wbond=weights(17)
- scal14=weights(18)
- wsccor=weights(21)
- endif
- call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
- time_Bcast=time_Bcast+MPI_Wtime()-time00
- time_Bcastw=time_Bcastw+MPI_Wtime()-time00
-c call chainbuild_cart
-c call int_from_cart1(.false.)
- endif
-c write (iout,*) 'Processor',myrank,
-c & ' calling etotal_short ipot=',ipot
-c call flush(iout)
-c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
-#endif
-cd print *,'nnt=',nnt,' nct=',nct
-C
-C Compute the side-chain and electrostatic interaction energy
-C
- goto (101,102,103,104,105,106) ipot
-C Lennard-Jones potential.
- 101 call elj_long(evdw)
-cd print '(a)','Exit ELJ'
- goto 107
-C Lennard-Jones-Kihara potential (shifted).
- 102 call eljk_long(evdw)
- goto 107
-C Berne-Pechukas potential (dilated LJ, angular dependence).
- 103 call ebp_long(evdw)
- goto 107
-C Gay-Berne potential (shifted LJ, angular dependence).
- 104 call egb_long(evdw,evdw_p,evdw_m)
- goto 107
-C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
- 105 call egbv_long(evdw)
- goto 107
-C Soft-sphere potential
- 106 call e_softsphere(evdw)
-C
-C Calculate electrostatic (H-bonding) energy of the main chain.
-C
- 107 continue
- call vec_and_deriv
- if (ipot.lt.6) then
-#ifdef SPLITELE
- if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
- & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
- & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
- & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
-#else
- if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
- & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
- & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
- & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
-#endif
- call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
- else
- ees=0
- evdw1=0
- eel_loc=0
- eello_turn3=0
- eello_turn4=0
- endif
- else
-c write (iout,*) "Soft-spheer ELEC potential"
- call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
- & eello_turn4)
- endif
-C
-C Calculate excluded-volume interaction energy between peptide groups
-C and side chains.
-C
- if (ipot.lt.6) then
- if(wscp.gt.0d0) then
- call escp_long(evdw2,evdw2_14)
- else
- evdw2=0
- evdw2_14=0
- endif
- else
- call escp_soft_sphere(evdw2,evdw2_14)
- endif
-C
-C 12/1/95 Multi-body terms
-C
- n_corr=0
- n_corr1=0
- if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
- & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
- call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
-c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
-c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
- else
- ecorr=0.0d0
- ecorr5=0.0d0
- ecorr6=0.0d0
- eturn6=0.0d0
- endif
- if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
- call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
- endif
-C
-C If performing constraint dynamics, call the constraint energy
-C after the equilibration time
- if(usampl.and.totT.gt.eq_time) then
- call EconstrQ
- call Econstr_back
- else
- Uconst=0.0d0
- Uconst_back=0.0d0
- endif
-C
-C Sum the energies
-C
- do i=1,n_ene
- energia(i)=0.0d0
- enddo
- energia(1)=evdw
-#ifdef SCP14
- energia(2)=evdw2-evdw2_14
- energia(18)=evdw2_14
-#else
- energia(2)=evdw2
- energia(18)=0.0d0
-#endif
-#ifdef SPLITELE
- energia(3)=ees
- energia(16)=evdw1
-#else
- energia(3)=ees+evdw1
- energia(16)=0.0d0
-#endif
- energia(4)=ecorr
- energia(5)=ecorr5
- energia(6)=ecorr6
- energia(7)=eel_loc
- energia(8)=eello_turn3
- energia(9)=eello_turn4
- energia(10)=eturn6
- energia(20)=Uconst+Uconst_back
- energia(22)=evdw_p
- energia(23)=evdw_m
- call sum_energy(energia,.true.)
-c write (iout,*) "Exit ETOTAL_LONG"
- call flush(iout)
- return
- end
-c------------------------------------------------------------------------------
- subroutine etotal_short(energia)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-c
-c Compute the short-range fast-varying contributions to the energy
-c
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
-#ifdef MPI
- include "mpif.h"
- double precision weights_(n_ene)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision energia(0:n_ene)
- include 'COMMON.FFIELD'
- include 'COMMON.DERIV'
- include 'COMMON.INTERACT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
-
-c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
-c call flush(iout)
- if (modecalc.eq.12.or.modecalc.eq.14) then
-#ifdef MPI
- if (fg_rank.eq.0) call int_from_cart1(.false.)
-#else
- call int_from_cart1(.false.)
-#endif
- endif
-#ifdef MPI
-c write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
-c & " absolute rank",myrank," nfgtasks",nfgtasks
-c call flush(iout)
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
-C FG slaves call the following matching MPI_Bcast in ERGASTULUM
- if (fg_rank.eq.0) then
- call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
-c write (iout,*) "Processor",myrank," BROADCAST iorder"
-c call flush(iout)
-C FG master sets up the WEIGHTS_ array which will be broadcast to the
-C FG slaves as WEIGHTS array.
- weights_(1)=wsc
- weights_(2)=wscp
- weights_(3)=welec
- weights_(4)=wcorr
- weights_(5)=wcorr5
- weights_(6)=wcorr6
- weights_(7)=wel_loc
- weights_(8)=wturn3
- weights_(9)=wturn4
- weights_(10)=wturn6
- weights_(11)=wang
- weights_(12)=wscloc
- weights_(13)=wtor
- weights_(14)=wtor_d
- weights_(15)=wstrain
- weights_(16)=wvdwpp
- weights_(17)=wbond
- weights_(18)=scal14
- weights_(21)=wsccor
-C FG Master broadcasts the WEIGHTS_ array
- call MPI_Bcast(weights_(1),n_ene,
- & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- else
-C FG slaves receive the WEIGHTS array
- call MPI_Bcast(weights(1),n_ene,
- & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
- wsc=weights(1)
- wscp=weights(2)
- welec=weights(3)
- wcorr=weights(4)
- wcorr5=weights(5)
- wcorr6=weights(6)
- wel_loc=weights(7)
- wturn3=weights(8)
- wturn4=weights(9)
- wturn6=weights(10)
- wang=weights(11)
- wscloc=weights(12)
- wtor=weights(13)
- wtor_d=weights(14)
- wstrain=weights(15)
- wvdwpp=weights(16)
- wbond=weights(17)
- scal14=weights(18)
- wsccor=weights(21)
- endif
-c write (iout,*),"Processor",myrank," BROADCAST weights"
- call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
-c write (iout,*) "Processor",myrank," BROADCAST c"
- call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
-c write (iout,*) "Processor",myrank," BROADCAST dc"
- call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
-c write (iout,*) "Processor",myrank," BROADCAST dc_norm"
- call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
-c write (iout,*) "Processor",myrank," BROADCAST theta"
- call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
-c write (iout,*) "Processor",myrank," BROADCAST phi"
- call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
-c write (iout,*) "Processor",myrank," BROADCAST alph"
- call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
-c write (iout,*) "Processor",myrank," BROADCAST omeg"
- call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
-c write (iout,*) "Processor",myrank," BROADCAST vbld"
- call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
- time_Bcast=time_Bcast+MPI_Wtime()-time00
-c write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
- endif
-c write (iout,*) 'Processor',myrank,
-c & ' calling etotal_short ipot=',ipot
-c call flush(iout)
-c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
-#endif
-c call int_from_cart1(.false.)
-C
-C Compute the side-chain and electrostatic interaction energy
-C
- goto (101,102,103,104,105,106) ipot
-C Lennard-Jones potential.
- 101 call elj_short(evdw)
-cd print '(a)','Exit ELJ'
- goto 107
-C Lennard-Jones-Kihara potential (shifted).
- 102 call eljk_short(evdw)
- goto 107
-C Berne-Pechukas potential (dilated LJ, angular dependence).
- 103 call ebp_short(evdw)
- goto 107
-C Gay-Berne potential (shifted LJ, angular dependence).
- 104 call egb_short(evdw,evdw_p,evdw_m)
- goto 107
-C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
- 105 call egbv_short(evdw)
- goto 107
-C Soft-sphere potential - already dealt with in the long-range part
- 106 evdw=0.0d0
-c 106 call e_softsphere_short(evdw)
-C
-C Calculate electrostatic (H-bonding) energy of the main chain.
-C
- 107 continue
-c
-c Calculate the short-range part of Evdwpp
-c
- call evdwpp_short(evdw1)
-c
-c Calculate the short-range part of ESCp
-c
- if (ipot.lt.6) then
- call escp_short(evdw2,evdw2_14)
- endif
-c
-c Calculate the bond-stretching energy
-c
- call ebond(estr)
-C
-C Calculate the disulfide-bridge and other energy and the contributions
-C from other distance constraints.
- call edis(ehpb)
-C
-C Calculate the virtual-bond-angle energy.
-C
- call ebend(ebe)
-C
-C Calculate the SC local energy.
-C
- call vec_and_deriv
- call esc(escloc)
-C
-C Calculate the virtual-bond torsional energy.
-C
- call etor(etors,edihcnstr)
-C
-C 6/23/01 Calculate double-torsional energy
-C
- call etor_d(etors_d)
-C
-C 21/5/07 Calculate local sicdechain correlation energy
-C
- if (wsccor.gt.0.0d0) then
- call eback_sc_corr(esccor)
- else
- esccor=0.0d0
- endif
-C
-C Put energy components into an array
-C
- do i=1,n_ene
- energia(i)=0.0d0
- enddo
- energia(1)=evdw
-#ifdef SCP14
- energia(2)=evdw2-evdw2_14
- energia(18)=evdw2_14
-#else
- energia(2)=evdw2
- energia(18)=0.0d0
-#endif
-#ifdef SPLITELE
- energia(16)=evdw1
-#else
- energia(3)=evdw1
-#endif
- energia(11)=ebe
- energia(12)=escloc
- energia(13)=etors
- energia(14)=etors_d
- energia(15)=ehpb
- energia(17)=estr
- energia(19)=edihcnstr
- energia(21)=esccor
- energia(22)=evdw_p
- energia(23)=evdw_m
-c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
- call flush(iout)
- call sum_energy(energia,.true.)
-c write (iout,*) "Exit ETOTAL_SHORT"
- call flush(iout)
- return
- end
+++ /dev/null
- subroutine entmcm
-C Does modified entropic sampling in the space of minima.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
-#ifdef MPL
- include 'COMMON.INFO'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.MCM'
- include 'COMMON.MCE'
- include 'COMMON.CONTACTS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.THREAD'
- include 'COMMON.NAMES'
- logical accepted,not_done,over,ovrtim,error,lprint
- integer MoveType,nbond
- integer conf_comp
- double precision RandOrPert
- double precision varia(maxvar),elowest,ehighest,eold
- double precision przes(3),obr(3,3)
- double precision varold(maxvar)
- logical non_conv
- double precision energia(0:n_ene),energia_ave(0:n_ene)
-C
-cd write (iout,*) 'print_mc=',print_mc
- WhatsUp=0
- maxtrial_iter=50
-c---------------------------------------------------------------------------
-C Initialize counters.
-c---------------------------------------------------------------------------
-C Total number of generated confs.
- ngen=0
-C Total number of moves. In general this won't be equal to the number of
-C attempted moves, because we may want to reject some "bad" confs just by
-C overlap check.
- nmove=0
-C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,...
-C motions.
- do i=1,nres
- nbond_move(i)=0
- enddo
-C Initialize total and accepted number of moves of various kind.
- do i=0,MaxMoveType
- moves(i)=0
- moves_acc(i)=0
- enddo
-C Total number of energy evaluations.
- neneval=0
- nfun=0
- indminn=-max_ene
- indmaxx=max_ene
- delte=0.5D0
- facee=1.0D0/(maxacc*delte)
- conste=dlog(facee)
-C Read entropy from previous simulations.
- if (ent_read) then
- read (ientin,*) indminn,indmaxx,emin,emax
- print *,'indminn=',indminn,' indmaxx=',indmaxx,' emin=',emin,
- & ' emax=',emax
- do i=-max_ene,max_ene
- entropy(i)=(emin+i*delte)*betbol
- enddo
- read (ientin,*) (ijunk,ejunk,entropy(i),i=indminn,indmaxx)
- indmin=indminn
- indmax=indmaxx
- write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx,
- & ' emin=',emin,' emax=',emax
- write (iout,'(/a)') 'Initial entropy'
- do i=indminn,indmaxx
- write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i)
- enddo
- endif ! ent_read
-C Read the pool of conformations
- call read_pool
-C----------------------------------------------------------------------------
-C Entropy-sampling simulations with continually updated entropy
-C Loop thru simulations
-C----------------------------------------------------------------------------
- DO ISWEEP=1,NSWEEP
-C----------------------------------------------------------------------------
-C Take a conformation from the pool
-C----------------------------------------------------------------------------
- if (npool.gt.0) then
- ii=iran_num(1,npool)
- do i=1,nvar
- varia(i)=xpool(i,ii)
- enddo
- write (iout,*) 'Took conformation',ii,' from the pool energy=',
- & epool(ii)
- call var_to_geom(nvar,varia)
-C Print internal coordinates of the initial conformation
- call intout
- else
- call gen_rand_conf(1,*20)
- endif
-C----------------------------------------------------------------------------
-C Compute and print initial energies.
-C----------------------------------------------------------------------------
- nsave=0
-#ifdef MPL
- if (MyID.eq.MasterID) then
- do i=1,nctasks
- nsave_part(i)=0
- enddo
- endif
-#endif
- Kwita=0
- WhatsUp=0
- write (iout,'(/80(1h*)/a,i2/80(1h*)/)') 'MCE iteration #',isweep
- write (iout,'(/80(1h*)/a)') 'Initial energies:'
- call chainbuild
- call etotal(energia(0))
- etot = energia(0)
- call enerprint(energia(0))
-C Minimize the energy of the first conformation.
- if (minim) then
- call geom_to_var(nvar,varia)
- call minimize(etot,varia,iretcode,nfun)
- call etotal(energia(0))
- etot = energia(0)
- write (iout,'(/80(1h*)/a/80(1h*))')
- & 'Results of the first energy minimization:'
- call enerprint(energia(0))
- endif
- if (refstr) then
- call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes,
- & obr,non_conv)
- rms=dsqrt(rms)
- call contact(.false.,ncont,icont,co)
- frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
- write (iout,'(a,f8.3,a,f8.3,a,f8.3)')
- & 'RMS deviation from the reference structure:',rms,
- & ' % of native contacts:',frac*100,' contact order:',co
- write (istat,'(i5,11(1pe14.5))') 0,
- & (energia(print_order(i)),i=1,nprint_ene),etot,rms,frac,co
- else
- write (istat,'(i5,9(1pe14.5))') 0,
- & (energia(print_order(i)),i=1,nprint_ene),etot
- endif
- close(istat)
- neneval=neneval+nfun+1
- if (.not. ent_read) then
-C Initialize the entropy array
- do i=-max_ene,max_ene
- emin=etot
-C Uncomment the line below for actual entropic sampling (start with uniform
-C energy distribution).
-c entropy(i)=0.0D0
-C Uncomment the line below for multicanonical sampling (start with Boltzmann
-C distribution).
- entropy(i)=(emin+i*delte)*betbol
- enddo
- emax=10000000.0D0
- emin=etot
- write (iout,'(/a)') 'Initial entropy'
- do i=indminn,indmaxx
- write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i)
- enddo
- endif ! ent_read
-#ifdef MPL
- call recv_stop_sig(Kwita)
- if (whatsup.eq.1) then
- call send_stop_sig(-2)
- not_done=.false.
- else if (whatsup.le.-2) then
- not_done=.false.
- else if (whatsup.eq.2) then
- not_done=.false.
- else
- not_done=.true.
- endif
-#else
- not_done = (iretcode.ne.11)
-#endif
- write (iout,'(/80(1h*)/20x,a/80(1h*))')
- & 'Enter Monte Carlo procedure.'
- close(igeom)
- call briefout(0,etot)
- do i=1,nvar
- varold(i)=varia(i)
- enddo
- eold=etot
- indeold=(eold-emin)/delte
- deix=eold-(emin+indeold*delte)
- dent=entropy(indeold+1)-entropy(indeold)
-cd write (iout,*) 'indeold=',indeold,' deix=',deix,' dent=',dent
-cd write (*,*) 'Processor',MyID,' indeold=',indeold,' deix=',deix,
-cd & ' dent=',dent
- sold=entropy(indeold)+(dent/delte)*deix
- elowest=etot
- write (iout,*) 'eold=',eold,' sold=',sold,' elowest=',etot
- write (*,*) 'Processor',MyID,' eold=',eold,' sold=',sold,
- & ' elowest=',etot
- if (minim) call zapis(varia,etot)
- nminima(1)=1.0D0
-C NACC is the counter for the accepted conformations of a given processor
- nacc=0
-C NACC_TOT counts the total number of accepted conformations
- nacc_tot=0
-#ifdef MPL
- if (MyID.eq.MasterID) then
- call receive_MCM_info
- else
- call send_MCM_info(2)
- endif
-#endif
- do iene=indminn,indmaxx
- nhist(iene)=0.0D0
- enddo
- do i=2,maxsave
- nminima(i)=0.0D0
- enddo
-C Main loop.
-c----------------------------------------------------------------------------
- elowest=1.0D10
- ehighest=-1.0D10
- it=0
- do while (not_done)
- it=it+1
- if (print_mc.gt.0) write (iout,'(80(1h*)/20x,a,i7)')
- & 'Beginning iteration #',it
-C Initialize local counter.
- ntrial=0 ! # of generated non-overlapping confs.
- noverlap=0 ! # of overlapping confs.
- accepted=.false.
- do while (.not. accepted .and. WhatsUp.eq.0 .and. Kwita.eq.0)
- ntrial=ntrial+1
-C Retrieve the angles of previously accepted conformation
- do j=1,nvar
- varia(j)=varold(j)
- enddo
-cd write (iout,'(a)') 'Old variables:'
-cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar)
- call var_to_geom(nvar,varia)
-C Rebuild the chain.
- call chainbuild
- MoveType=0
- nbond=0
- lprint=.true.
-C Decide whether to generate a random conformation or perturb the old one
- RandOrPert=ran_number(0.0D0,1.0D0)
- if (RandOrPert.gt.RanFract) then
- if (print_mc.gt.0)
- & write (iout,'(a)') 'Perturbation-generated conformation.'
- call perturb(error,lprint,MoveType,nbond,1.0D0)
- if (error) goto 20
- if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then
- write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=',
- & MoveType,' returned from PERTURB.'
- goto 20
- endif
- call chainbuild
- else
- MoveType=0
- moves(0)=moves(0)+1
- nstart_grow=iran_num(3,nres)
- if (print_mc.gt.0)
- & write (iout,'(2a,i3)') 'Random-generated conformation',
- & ' - chain regrown from residue',nstart_grow
- call gen_rand_conf(nstart_grow,*30)
- endif
- call geom_to_var(nvar,varia)
-cd write (iout,'(a)') 'New variables:'
-cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar)
- ngen=ngen+1
- if (print_mc.gt.0) write (iout,'(a,i5,a,i10,a,i10)')
- & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen
- if (print_mc.gt.0) write (*,'(a,i5,a,i10,a,i10)')
- & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen
- call etotal(energia(0))
- etot = energia(0)
-c call enerprint(energia(0))
-c write (iout,'(2(a,1pe14.5))') 'Etot=',Etot,' Elowest=',Elowest
- if (etot-elowest.gt.overlap_cut) then
- write (iout,'(a,i5,a,1pe14.5)') 'Iteration',it,
- & ' Overlap detected in the current conf.; energy is',etot
- neneval=neneval+1
- accepted=.false.
- noverlap=noverlap+1
- if (noverlap.gt.maxoverlap) then
- write (iout,'(a)') 'Too many overlapping confs.'
- goto 20
- endif
- else
- if (minim) then
- call minimize(etot,varia,iretcode,nfun)
-cd write (iout,'(a)') 'Variables after minimization:'
-cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar)
- call etotal(energia(0))
- etot = energia(0)
- neneval=neneval+nfun+1
- endif
- if (print_mc.gt.2) then
- write (iout,'(a)') 'Total energies of trial conf:'
- call enerprint(energia(0))
- else if (print_mc.eq.1) then
- write (iout,'(a,i6,a,1pe16.6)')
- & 'Trial conformation:',ngen,' energy:',etot
- endif
-C--------------------------------------------------------------------------
-C... Acceptance test
-C--------------------------------------------------------------------------
- accepted=.false.
- if (WhatsUp.eq.0)
- & call accepting(etot,eold,scur,sold,varia,varold,
- & accepted)
- if (accepted) then
- nacc=nacc+1
- nacc_tot=nacc_tot+1
- if (elowest.gt.etot) elowest=etot
- if (ehighest.lt.etot) ehighest=etot
- moves_acc(MoveType)=moves_acc(MoveType)+1
- if (MoveType.eq.1) then
- nbond_acc(nbond)=nbond_acc(nbond)+1
- endif
-C Check against conformation repetitions.
- irep=conf_comp(varia,etot)
-#if defined(AIX) || defined(PGI)
- open (istat,file=statname,position='append')
-#else
- open (istat,file=statname,access='append')
-#endif
- if (refstr) then
- call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,
- & przes,obr,non_conv)
- rms=dsqrt(rms)
- call contact(.false.,ncont,icont,co)
- frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
- if (print_mc.gt.0)
- & write (iout,'(a,f8.3,a,f8.3,a,f8.3)')
- & 'RMS deviation from the reference structure:',rms,
- & ' % of native contacts:',frac*100,' contact order:',co
- if (print_stat)
- & write (istat,'(i5,11(1pe14.5))') it,
- & (energia(print_order(i)),i=1,nprint_ene),etot,
- & rms,frac,co
- elseif (print_stat) then
- write (istat,'(i5,10(1pe14.5))') it,
- & (energia(print_order(i)),i=1,nprint_ene),etot
- endif
- close(istat)
- if (print_mc.gt.1)
- & call statprint(nacc,nfun,iretcode,etot,elowest)
-C Print internal coordinates.
- if (print_int) call briefout(nacc,etot)
-#ifdef MPL
- if (MyID.ne.MasterID) then
- call recv_stop_sig(Kwita)
-cd print *,'Processor:',MyID,' STOP=',Kwita
- if (irep.eq.0) then
- call send_MCM_info(2)
- else
- call send_MCM_info(1)
- endif
- endif
-#endif
-C Store the accepted conf. and its energy.
- eold=etot
- sold=scur
- do i=1,nvar
- varold(i)=varia(i)
- enddo
- if (irep.eq.0) then
- irep=nsave+1
-cd write (iout,*) 'Accepted conformation:'
-cd write (iout,*) (rad2deg*varia(i),i=1,nphi)
- if (minim) call zapis(varia,etot)
- do i=1,n_ene
- ener(i,nsave)=energia(i)
- enddo
- ener(n_ene+1,nsave)=etot
- ener(n_ene+2,nsave)=frac
- endif
- nminima(irep)=nminima(irep)+1.0D0
-c print *,'irep=',irep,' nminima=',nminima(irep)
-#ifdef MPL
- if (Kwita.eq.0) call recv_stop_sig(kwita)
-#endif
- endif ! accepted
- endif ! overlap
-#ifdef MPL
- if (MyID.eq.MasterID) then
- call receive_MCM_info
- if (nacc_tot.ge.maxacc) accepted=.true.
- endif
-#endif
- if (ntrial.gt.maxtrial_iter .and. npool.gt.0) then
-C Take a conformation from the pool
- ii=iran_num(1,npool)
- do i=1,nvar
- varia(i)=xpool(i,ii)
- enddo
- write (iout,*) 'Iteration',it,' max. # of trials exceeded.'
- write (iout,*)
- & 'Take conformation',ii,' from the pool energy=',epool(ii)
- if (print_mc.gt.2)
- & write (iout,'(10f8.3)') (rad2deg*varia(i),i=1,nvar)
- ntrial=0
- endif ! (ntrial.gt.maxtrial_iter .and. npool.gt.0)
- 30 continue
- enddo ! accepted
-#ifdef MPL
- if (MyID.eq.MasterID) then
- call receive_MCM_info
- endif
- if (Kwita.eq.0) call recv_stop_sig(kwita)
-#endif
- if (ovrtim()) WhatsUp=-1
-cd write (iout,*) 'WhatsUp=',WhatsUp,' Kwita=',Kwita
- not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0)
- & .and. (Kwita.eq.0)
-cd write (iout,*) 'not_done=',not_done
-#ifdef MPL
- if (Kwita.lt.0) then
- print *,'Processor',MyID,
- & ' has received STOP signal =',Kwita,' in EntSamp.'
-cd print *,'not_done=',not_done
- if (Kwita.lt.-1) WhatsUp=Kwita
- else if (nacc_tot.ge.maxacc) then
- print *,'Processor',MyID,' calls send_stop_sig,',
- & ' because a sufficient # of confs. have been collected.'
-cd print *,'not_done=',not_done
- call send_stop_sig(-1)
- else if (WhatsUp.eq.-1) then
- print *,'Processor',MyID,
- & ' calls send_stop_sig because of timeout.'
-cd print *,'not_done=',not_done
- call send_stop_sig(-2)
- endif
-#endif
- enddo ! not_done
-
-C-----------------------------------------------------------------
-C... Construct energy histogram & update entropy
-C-----------------------------------------------------------------
- go to 21
- 20 WhatsUp=-3
-#ifdef MPL
- write (iout,*) 'Processor',MyID,
- & ' is broadcasting ERROR-STOP signal.'
- write (*,*) 'Processor',MyID,
- & ' is broadcasting ERROR-STOP signal.'
- call send_stop_sig(-3)
-#endif
- 21 continue
-#ifdef MPL
- if (MyID.eq.MasterID) then
-c call receive_MCM_results
- call receive_energies
-#endif
- do i=1,nsave
- if (esave(i).lt.elowest) elowest=esave(i)
- if (esave(i).gt.ehighest) ehighest=esave(i)
- enddo
- write (iout,'(a,i10)') '# of accepted confs:',nacc_tot
- write (iout,'(a,f10.5,a,f10.5)') 'Lowest energy:',elowest,
- & ' Highest energy',ehighest
- if (isweep.eq.1 .and. .not.ent_read) then
- emin=elowest
- emax=ehighest
- write (iout,*) 'EMAX=',emax
- indminn=0
- indmaxx=(ehighest-emin)/delte
- indmin=indminn
- indmax=indmaxx
- do i=-max_ene,max_ene
- entropy(i)=(emin+i*delte)*betbol
- enddo
- ent_read=.true.
- else
- indmin=(elowest-emin)/delte
- indmax=(ehighest-emin)/delte
- if (indmin.lt.indminn) indminn=indmin
- if (indmax.gt.indmaxx) indmaxx=indmax
- endif
- write(iout,*)'indminn=',indminn,' indmaxx=',indmaxx
-C Construct energy histogram
- do i=1,nsave
- inde=(esave(i)-emin)/delte
- nhist(inde)=nhist(inde)+nminima(i)
- enddo
-C Update entropy (density of states)
- do i=indmin,indmax
- if (nhist(i).gt.0) then
- entropy(i)=entropy(i)+dlog(nhist(i)+0.0D0)
- endif
- enddo
-Cd do i=indmaxx+1
-Cd entropy(i)=1.0D+10
-Cd enddo
- write (iout,'(/80(1h*)/a,i2/80(1h*)/)')
- & 'End of macroiteration',isweep
- write (iout,'(a,f10.5,a,f10.5)') 'Elowest=',elowest,
- & ' Ehighest=',ehighest
- write (iout,'(a)') 'Frequecies of minima'
- do i=1,nsave
- write (iout,'(i5,f5.0,f10.5)') i,nminima(i),esave(i)
- enddo
- write (iout,'(/a)') 'Energy histogram'
- do i=indminn,indmaxx
- write (iout,'(i5,2f10.5)') i,emin+i*delte,nhist(i)
- enddo
- write (iout,'(/a)') 'Entropy'
- do i=indminn,indmaxx
- write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i)
- enddo
-C-----------------------------------------------------------------
-C... End of energy histogram construction
-C-----------------------------------------------------------------
-#ifdef MPL
- entropy(-max_ene-4)=dfloat(indminn)
- entropy(-max_ene-3)=dfloat(indmaxx)
- entropy(-max_ene-2)=emin
- entropy(-max_ene-1)=emax
- call send_MCM_update
-cd print *,entname,ientout
- open (ientout,file=entname,status='unknown')
- write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax
- do i=indminn,indmaxx
- write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i)
- enddo
- close(ientout)
- else
- write (iout,'(a)') 'Frequecies of minima'
- do i=1,nsave
- write (iout,'(i5,f5.0,f10.5)') i,nminima(i),esave(i)
- enddo
-c call send_MCM_results
- call send_energies
- call receive_MCM_update
- indminn=entropy(-max_ene-4)
- indmaxx=entropy(-max_ene-3)
- emin=entropy(-max_ene-2)
- emax=entropy(-max_ene-1)
- write (iout,*) 'Received from master:'
- write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx,
- & ' emin=',emin,' emax=',emax
- write (iout,'(/a)') 'Entropy'
- do i=indminn,indmaxx
- write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i)
- enddo
- endif
- if (WhatsUp.lt.-1) return
-#else
- if (ovrtim() .or. WhatsUp.lt.0) return
-#endif
-
- write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:'
- call statprint(nacc,nfun,iretcode,etot,elowest)
- write (iout,'(a)')
- & 'Statistics of multiple-bond motions. Total motions:'
- write (iout,'(16i5)') (nbond_move(i),i=1,Nbm)
- write (iout,'(a)') 'Accepted motions:'
- write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm)
- write (iout,'(a,i10)') 'Number of chain regrowths:',nregrow
- write (iout,'(a,i10)') 'Accepted chain regrowths:',nregrow_acc
-
-C---------------------------------------------------------------------------
- ENDDO ! ISWEEP
-C---------------------------------------------------------------------------
-
- runtime=tcpu()
-
- if (isweep.eq.nsweep .and. it.ge.maxacc)
- &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.'
- return
- end
-c------------------------------------------------------------------------------
- subroutine accepting(ecur,eold,scur,sold,x,xold,accepted)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.MCE'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
-#ifdef MPL
- include 'COMMON.INFO'
-#endif
- include 'COMMON.GEO'
- double precision ecur,eold,xx,ran_number,bol
- double precision x(maxvar),xold(maxvar)
- double precision tole /1.0D-1/, tola /5.0D0/
- logical accepted
-C Check if the conformation is similar.
-cd write (iout,*) 'Enter ACCEPTING'
-cd write (iout,*) 'Old PHI angles:'
-cd write (iout,*) (rad2deg*xold(i),i=1,nphi)
-cd write (iout,*) 'Current angles'
-cd write (iout,*) (rad2deg*x(i),i=1,nphi)
-cd ddif=dif_ang(nphi,x,xold)
-cd write (iout,*) 'Angle norm:',ddif
-cd write (iout,*) 'ecur=',ecur,' emax=',emax
- if (ecur.gt.emax) then
- accepted=.false.
- if (print_mc.gt.0)
- & write (iout,'(a)') 'Conformation rejected as too high in energy'
- return
- else if (dabs(ecur-eold).lt.tole .and.
- & dif_ang(nphi,x,xold).lt.tola) then
- accepted=.false.
- if (print_mc.gt.0)
- & write (iout,'(a)') 'Conformation rejected as too similar'
- return
- endif
-C Else evaluate the entropy of the conf and compare it with that of the previous
-C one.
- indecur=(ecur-emin)/delte
- if (iabs(indecur).gt.max_ene) then
- write (iout,'(a,2i5)')
- & 'Accepting: Index out of range:',indecur
- scur=1000.0D0
- else if (indecur.eq.indmaxx) then
- scur=entropy(indecur)
- if (print_mc.gt.0) write (iout,*)'Energy boundary reached',
- & indmaxx,indecur,entropy(indecur)
- else
- deix=ecur-(emin+indecur*delte)
- dent=entropy(indecur+1)-entropy(indecur)
- scur=entropy(indecur)+(dent/delte)*deix
- endif
-cd print *,'Processor',MyID,' ecur=',ecur,' indecur=',indecur,
-cd & ' scur=',scur,' eold=',eold,' sold=',sold
-cd print *,'deix=',deix,' dent=',dent,' delte=',delte
- if (print_mc.gt.1) then
- write(iout,*)'ecur=',ecur,' indecur=',indecur,' scur=',scur
- write(iout,*)'eold=',eold,' sold=',sold
- endif
- if (scur.le.sold) then
- accepted=.true.
- else
-C Else carry out acceptance test
- xx=ran_number(0.0D0,1.0D0)
- xxh=scur-sold
- if (xxh.gt.50.0D0) then
- bol=0.0D0
- else
- bol=exp(-xxh)
- endif
- if (bol.gt.xx) then
- accepted=.true.
- if (print_mc.gt.0) write (iout,'(a)')
- & 'Conformation accepted.'
- else
- accepted=.false.
- if (print_mc.gt.0) write (iout,'(a)')
- & 'Conformation rejected.'
- endif
- endif
- return
- end
-c-----------------------------------------------------------------------------
- subroutine read_pool
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.MCM'
- include 'COMMON.MCE'
- include 'COMMON.VAR'
- double precision varia(maxvar)
- print '(a)','Call READ_POOL'
- do npool=1,max_pool
- print *,'i=',i
- read (intin,'(i5,f10.5)',end=10,err=10) iconf,epool(npool)
- if (epool(npool).eq.0.0D0) goto 10
- call read_angles(intin,*10)
- call geom_to_var(nvar,xpool(1,npool))
- enddo
- goto 11
- 10 npool=npool-1
- 11 write (iout,'(a,i5)') 'Number of pool conformations:',npool
- if (print_mc.gt.2) then
- do i=1,npool
- write (iout,'(a,i5,a,1pe14.5)') 'Pool conformation',i,' energy',
- & epool(i)
- write (iout,'(10f8.3)') (rad2deg*xpool(j,i),j=1,nvar)
- enddo
- endif ! (print_mc.gt.2)
- return
- end
+++ /dev/null
- subroutine fitsq(rms,x,y,nn,t,b,non_conv)
- implicit real*8 (a-h,o-z)
- include 'COMMON.IOUNITS'
-c x and y are the vectors of coordinates (dimensioned (3,n)) of the two
-c structures to be superimposed. nn is 3*n, where n is the number of
-c points. t and b are respectively the translation vector and the
-c rotation matrix that transforms the second set of coordinates to the
-c frame of the first set.
-c eta = machine-specific variable
-
- dimension x(3*nn),y(3*nn),t(3)
- dimension b(3,3),q(3,3),r(3,3),v(3),xav(3),yav(3),e(3),c(3,3)
- logical non_conv
-c eta = z00100000
-c small=25.0*rmdcon(3)
-c small=25.0*eta
-c small=25.0*10.e-10
-c the following is a very lenient value for 'small'
- small = 0.0001D0
- non_conv=.false.
- fn=nn
- do 10 i=1,3
- xav(i)=0.0D0
- yav(i)=0.0D0
- do 10 j=1,3
- 10 b(j,i)=0.0D0
- nc=0
-c
- do 30 n=1,nn
- do 20 i=1,3
-c write(iout,*)'x = ',x(nc+i),' y = ',y(nc+i)
- xav(i)=xav(i)+x(nc+i)/fn
- 20 yav(i)=yav(i)+y(nc+i)/fn
- 30 nc=nc+3
-c
- do i=1,3
- t(i)=yav(i)-xav(i)
- enddo
-
- rms=0.0d0
- do n=1,nn
- do i=1,3
- rms=rms+(y(3*(n-1)+i)-x(3*(n-1)+i)-t(i))**2
- enddo
- enddo
- rms=dabs(rms/fn)
-
-c write(iout,*)'xav = ',(xav(j),j=1,3)
-c write(iout,*)'yav = ',(yav(j),j=1,3)
-c write(iout,*)'t = ',(t(j),j=1,3)
-c write(iout,*)'rms=',rms
- if (rms.lt.small) return
-
-
- nc=0
- rms=0.0D0
- do 50 n=1,nn
- do 40 i=1,3
- rms=rms+((x(nc+i)-xav(i))**2+(y(nc+i)-yav(i))**2)/fn
- do 40 j=1,3
- b(j,i)=b(j,i)+(x(nc+i)-xav(i))*(y(nc+j)-yav(j))/fn
- 40 c(j,i)=b(j,i)
- 50 nc=nc+3
- call sivade(b,q,r,d,non_conv)
- sn3=dsign(1.0d0,d)
- do 120 i=1,3
- do 120 j=1,3
- 120 b(j,i)=-q(j,1)*r(i,1)-q(j,2)*r(i,2)-sn3*q(j,3)*r(i,3)
- call mvvad(b,xav,yav,t)
- do 130 i=1,3
- do 130 j=1,3
- rms=rms+2.0*c(j,i)*b(j,i)
- 130 b(j,i)=-b(j,i)
- if (dabs(rms).gt.small) go to 140
-* write (6,301)
- return
- 140 if (rms.gt.0.0d0) go to 150
-c write (iout,303) rms
- rms=0.0d0
-* stop
-c 150 write (iout,302) dsqrt(rms)
- 150 continue
- return
- 301 format (5x,'rms deviation negligible')
- 302 format (5x,'rms deviation ',f14.6)
- 303 format (//,5x,'negative ms deviation - ',f14.6)
- end
-c
- subroutine sivade(x,q,r,dt,non_conv)
- implicit real*8(a-h,o-z)
-c computes q,e and r such that q(t)xr = diag(e)
- dimension x(3,3),q(3,3),r(3,3),e(3)
- dimension h(3,3),p(3,3),u(3,3),d(3)
- logical non_conv
-c eta = z00100000
-c write (2,*) "SIVADE"
- nit = 0
- small=25.0*10.d-10
-c small=25.0*eta
-c small=2.0*rmdcon(3)
- xnrm=0.0d0
- do 20 i=1,3
- do 10 j=1,3
- xnrm=xnrm+x(j,i)*x(j,i)
- u(j,i)=0.0d0
- r(j,i)=0.0d0
- 10 h(j,i)=0.0d0
- u(i,i)=1.0
- 20 r(i,i)=1.0
- xnrm=dsqrt(xnrm)
- do 110 n=1,2
- xmax=0.0d0
- do 30 j=n,3
- 30 if (dabs(x(j,n)).gt.xmax) xmax=dabs(x(j,n))
- a=0.0d0
- do 40 j=n,3
- h(j,n)=x(j,n)/xmax
- 40 a=a+h(j,n)*h(j,n)
- a=dsqrt(a)
- den=a*(a+dabs(h(n,n)))
- d(n)=1.0/den
- h(n,n)=h(n,n)+dsign(a,h(n,n))
- do 70 i=n,3
- s=0.0d0
- do 50 j=n,3
- 50 s=s+h(j,n)*x(j,i)
- s=d(n)*s
- do 60 j=n,3
- 60 x(j,i)=x(j,i)-s*h(j,n)
- 70 continue
- if (n.gt.1) go to 110
- xmax=dmax1(dabs(x(1,2)),dabs(x(1,3)))
- h(2,3)=x(1,2)/xmax
- h(3,3)=x(1,3)/xmax
- a=dsqrt(h(2,3)*h(2,3)+h(3,3)*h(3,3))
- den=a*(a+dabs(h(2,3)))
- d(3)=1.0/den
- h(2,3)=h(2,3)+sign(a,h(2,3))
- do 100 i=1,3
- s=0.0d0
- do 80 j=2,3
- 80 s=s+h(j,3)*x(i,j)
- s=d(3)*s
- do 90 j=2,3
- 90 x(i,j)=x(i,j)-s*h(j,3)
- 100 continue
- 110 continue
- do 130 i=1,3
- do 120 j=1,3
- 120 p(j,i)=-d(1)*h(j,1)*h(i,1)
- 130 p(i,i)=1.0+p(i,i)
- do 140 i=2,3
- do 140 j=2,3
- u(j,i)=u(j,i)-d(2)*h(j,2)*h(i,2)
- 140 r(j,i)=r(j,i)-d(3)*h(j,3)*h(i,3)
- call mmmul(p,u,q)
- 150 np=1
- nq=1
- nit=nit+1
-c write (2,*) "nit",nit," e",(x(i,i),i=1,3)
- if (nit.gt.10000) then
- print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!'
- non_conv=.true.
- return
- endif
- if (dabs(x(2,3)).gt.small*(dabs(x(2,2))+abs(x(3,3)))) go to 160
- x(2,3)=0.0d0
- nq=nq+1
- 160 if (dabs(x(1,2)).gt.small*(dabs(x(1,1))+dabs(x(2,2)))) go to 180
- x(1,2)=0.0d0
- if (x(2,3).ne.0.0d0) go to 170
- nq=nq+1
- go to 180
- 170 np=np+1
- 180 if (nq.eq.3) go to 310
- npq=4-np-nq
-c write (2,*) "np",np," npq",npq
- if (np.gt.npq) go to 230
- n0=0
- do 220 n=np,npq
- nn=n+np-1
-c write (2,*) "nn",nn
- if (dabs(x(nn,nn)).gt.small*xnrm) go to 220
- x(nn,nn)=0.0d0
- if (x(nn,nn+1).eq.0.0d0) go to 220
- n0=n0+1
-c write (2,*) "nn",nn
- go to (190,210,220),nn
- 190 do 200 j=2,3
- 200 call givns(x,q,1,j)
- go to 220
- 210 call givns(x,q,2,3)
- 220 continue
-c write (2,*) "nn",nn," np",np," nq",nq," n0",n0
-c write (2,*) "x",(x(i,i),i=1,3)
- if (n0.ne.0) go to 150
- 230 nn=3-nq
- a=x(nn,nn)*x(nn,nn)
- if (nn.gt.1) a=a+x(nn-1,nn)*x(nn-1,nn)
- b=x(nn+1,nn+1)*x(nn+1,nn+1)+x(nn,nn+1)*x(nn,nn+1)
- c=x(nn,nn)*x(nn,nn+1)
- dd=0.5*(a-b)
- xn2=c*c
- rt=b-xn2/(dd+sign(dsqrt(dd*dd+xn2),dd))
- y=x(np,np)*x(np,np)-rt
- z=x(np,np)*x(np,np+1)
- do 300 n=np,nn
-c write (2,*) "n",n," a",a," b",b," c",c," y",y," z",z
- if (dabs(y).lt.dabs(z)) go to 240
- t=z/y
- c=1.0/dsqrt(1.0d0+t*t)
- s=c*t
- go to 250
- 240 t=y/z
- s=1.0/dsqrt(1.0d0+t*t)
- c=s*t
- 250 do 260 j=1,3
- v=x(j,n)
- w=x(j,n+1)
- x(j,n)=c*v+s*w
- x(j,n+1)=-s*v+c*w
- a=r(j,n)
- b=r(j,n+1)
- r(j,n)=c*a+s*b
- 260 r(j,n+1)=-s*a+c*b
- y=x(n,n)
- z=x(n+1,n)
- if (dabs(y).lt.dabs(z)) go to 270
- t=z/y
- c=1.0/dsqrt(1.0+t*t)
- s=c*t
- go to 280
- 270 t=y/z
- s=1.0/dsqrt(1.0+t*t)
- c=s*t
- 280 do 290 j=1,3
- v=x(n,j)
- w=x(n+1,j)
- a=q(j,n)
- b=q(j,n+1)
- x(n,j)=c*v+s*w
- x(n+1,j)=-s*v+c*w
- q(j,n)=c*a+s*b
- 290 q(j,n+1)=-s*a+c*b
- if (n.ge.nn) go to 300
- y=x(n,n+1)
- z=x(n,n+2)
- 300 continue
- go to 150
- 310 do 320 i=1,3
- 320 e(i)=x(i,i)
- nit=0
- 330 n0=0
- nit=nit+1
- if (nit.gt.10000) then
- print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!'
- non_conv=.true.
- return
- endif
-c write (2,*) "e",(e(i),i=1,3)
- do 360 i=1,3
- if (e(i).ge.0.0d0) go to 350
- e(i)=-e(i)
- do 340 j=1,3
- 340 q(j,i)=-q(j,i)
- 350 if (i.eq.1) go to 360
- if (dabs(e(i)).lt.dabs(e(i-1))) go to 360
- call switch(i,1,q,r,e)
- n0=n0+1
- 360 continue
- if (n0.ne.0) go to 330
-c write (2,*) "e",(e(i),i=1,3)
- if (dabs(e(3)).gt.small*xnrm) go to 370
- e(3)=0.0d0
- if (dabs(e(2)).gt.small*xnrm) go to 370
- e(2)=0.0d0
- 370 dt=det(q(1,1),q(1,2),q(1,3))*det(r(1,1),r(1,2),r(1,3))
-c write (2,*) "nit",nit
-c write (2,501) (e(i),i=1,3)
- return
- 501 format (/,5x,'singular values - ',3e15.5)
- end
- subroutine givns(a,b,m,n)
- implicit real*8 (a-h,o-z)
- dimension a(3,3),b(3,3)
- if (dabs(a(m,n)).lt.dabs(a(n,n))) go to 10
- t=a(n,n)/a(m,n)
- s=1.0/dsqrt(1.0+t*t)
- c=s*t
- go to 20
- 10 t=a(m,n)/a(n,n)
- c=1.0/dsqrt(1.0+t*t)
- s=c*t
- 20 do 30 j=1,3
- v=a(m,j)
- w=a(n,j)
- x=b(j,m)
- y=b(j,n)
- a(m,j)=c*v-s*w
- a(n,j)=s*v+c*w
- b(j,m)=c*x-s*y
- 30 b(j,n)=s*x+c*y
- return
- end
- subroutine switch(n,m,u,v,d)
- implicit real*8 (a-h,o-z)
- dimension u(3,3),v(3,3),d(3)
- do 10 i=1,3
- tem=u(i,n)
- u(i,n)=u(i,n-1)
- u(i,n-1)=tem
- if (m.eq.0) go to 10
- tem=v(i,n)
- v(i,n)=v(i,n-1)
- v(i,n-1)=tem
- 10 continue
- tem=d(n)
- d(n)=d(n-1)
- d(n-1)=tem
- return
- end
- subroutine mvvad(b,xav,yav,t)
- implicit real*8 (a-h,o-z)
- dimension b(3,3),xav(3),yav(3),t(3)
-c dimension a(3,3),b(3),c(3),d(3)
-c do 10 j=1,3
-c d(j)=c(j)
-c do 10 i=1,3
-c 10 d(j)=d(j)+a(j,i)*b(i)
- do 10 j=1,3
- t(j)=yav(j)
- do 10 i=1,3
- 10 t(j)=t(j)+b(j,i)*xav(i)
- return
- end
- double precision function det (a,b,c)
- implicit real*8 (a-h,o-z)
- dimension a(3),b(3),c(3)
- det=a(1)*(b(2)*c(3)-b(3)*c(2))+a(2)*(b(3)*c(1)-b(1)*c(3))
- 1 +a(3)*(b(1)*c(2)-b(2)*c(1))
- return
- end
- subroutine mmmul(a,b,c)
- implicit real*8 (a-h,o-z)
- dimension a(3,3),b(3,3),c(3,3)
- do 10 i=1,3
- do 10 j=1,3
- c(i,j)=0.0d0
- do 10 k=1,3
- 10 c(i,j)=c(i,j)+a(i,k)*b(k,j)
- return
- end
- subroutine matvec(uvec,tmat,pvec,nback)
- implicit real*8 (a-h,o-z)
- real*8 tmat(3,3),uvec(3,nback), pvec(3,nback)
-c
- do 2 j=1,nback
- do 1 i=1,3
- uvec(i,j) = 0.0d0
- do 1 k=1,3
- 1 uvec(i,j)=uvec(i,j)+tmat(i,k)*pvec(k,j)
- 2 continue
- return
- end
+++ /dev/null
- subroutine gauss(RO,AP,MT,M,N,*)
-c
-c CALCULATES (RO**(-1))*AP BY GAUSS ELIMINATION
-c RO IS A SQUARE MATRIX
-c THE CALCULATED PRODUCT IS STORED IN AP
-c ABNORMAL EXIT IF RO IS SINGULAR
-c
- integer MT, M, N, M1,I,J,IM,
- & I1,MI,MI1
- double precision RO(MT,M),AP(MT,N),X,RM,PR,
- & Y
- if(M.ne.1)goto 10
- X=RO(1,1)
- if(dabs(X).le.1.0D-13) return 1
- X=1.0/X
- do 16 I=1,N
-16 AP(1,I)=AP(1,I)*X
- return
-10 continue
- M1=M-1
- DO1 I=1,M1
- IM=I
- RM=DABS(RO(I,I))
- I1=I+1
- do 2 J=I1,M
- if(DABS(RO(J,I)).LE.RM) goto 2
- RM=DABS(RO(J,I))
- IM=J
-2 continue
- If(IM.eq.I)goto 17
- do 3 J=1,N
- PR=AP(I,J)
- AP(I,J)=AP(IM,J)
-3 AP(IM,J)=PR
- do 4 J=I,M
- PR=RO(I,J)
- RO(I,J)=RO(IM,J)
-4 RO(IM,J)=PR
-17 X=RO(I,I)
- if(dabs(X).le.1.0E-13) return 1
- X=1.0/X
- do 5 J=1,N
-5 AP(I,J)=X*AP(I,J)
- do 6 J=I1,M
-6 RO(I,J)=X*RO(I,J)
- do 7 J=I1,M
- Y=RO(J,I)
- do 8 K=1,N
-8 AP(J,K)=AP(J,K)-Y*AP(I,K)
- do 9 K=I1,M
-9 RO(J,K)=RO(J,K)-Y*RO(I,K)
-7 continue
-1 continue
- X=RO(M,M)
- if(dabs(X).le.1.0E-13) return 1
- X=1.0/X
- do 11 J=1,N
-11 AP(M,J)=X*AP(M,J)
- do 12 I=1,M1
- MI=M-I
- MI1=MI+1
- do 14 J=1,N
- X=AP(MI,J)
- do 15 K=MI1,M
-15 X=X-AP(K,J)*RO(MI,K)
-14 AP(MI,J)=X
-12 continue
- return
- end
+++ /dev/null
- subroutine gen_rand_conf(nstart,*)
-C Generate random conformation or chain cut and regrowth.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.MCM'
- include 'COMMON.GEO'
- include 'COMMON.CONTROL'
- logical overlap,back,fail
-cd print *,' CG Processor',me,' maxgen=',maxgen
- maxsi=100
-cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart
- if (nstart.lt.5) then
- it1=itype(2)
- phi(4)=gen_phi(4,itype(2),itype(3))
-c write(iout,*)'phi(4)=',rad2deg*phi(4)
- if (nstart.lt.3) theta(3)=gen_theta(itype(2),pi,phi(4))
-c write(iout,*)'theta(3)=',rad2deg*theta(3)
- if (it1.ne.10) then
- nsi=0
- fail=.true.
- do while (fail.and.nsi.le.maxsi)
- call gen_side(it1,theta(3),alph(2),omeg(2),fail)
- nsi=nsi+1
- enddo
- if (nsi.gt.maxsi) return1
- endif ! it1.ne.10
- call orig_frame
- i=4
- nstart=4
- else
- i=nstart
- nstart=max0(i,4)
- endif
-
- maxnit=0
-
- nit=0
- niter=0
- back=.false.
- do while (i.le.nres .and. niter.lt.maxgen)
- if (i.lt.nstart) then
- if(iprint.gt.1) then
- write (iout,'(/80(1h*)/2a/80(1h*))')
- & 'Generation procedure went down to ',
- & 'chain beginning. Cannot continue...'
- write (*,'(/80(1h*)/2a/80(1h*))')
- & 'Generation procedure went down to ',
- & 'chain beginning. Cannot continue...'
- endif
- return1
- endif
- it1=itype(i-1)
- it2=itype(i-2)
- it=itype(i)
-c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2,
-c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen
- phi(i+1)=gen_phi(i+1,it1,it)
- if (back) then
- phi(i)=gen_phi(i+1,it2,it1)
-c print *,'phi(',i,')=',phi(i)
- theta(i-1)=gen_theta(it2,phi(i-1),phi(i))
- if (it2.ne.10) then
- nsi=0
- fail=.true.
- do while (fail.and.nsi.le.maxsi)
- call gen_side(it2,theta(i-1),alph(i-2),omeg(i-2),fail)
- nsi=nsi+1
- enddo
- if (nsi.gt.maxsi) return1
- endif
- call locate_next_res(i-1)
- endif
- theta(i)=gen_theta(it1,phi(i),phi(i+1))
- if (it1.ne.10) then
- nsi=0
- fail=.true.
- do while (fail.and.nsi.le.maxsi)
- call gen_side(it1,theta(i),alph(i-1),omeg(i-1),fail)
- nsi=nsi+1
- enddo
- if (nsi.gt.maxsi) return1
- endif
- call locate_next_res(i)
- if (overlap(i-1)) then
- if (nit.lt.maxnit) then
- back=.true.
- nit=nit+1
- else
- nit=0
- if (i.gt.3) then
- back=.true.
- i=i-1
- else
- write (iout,'(a)')
- & 'Cannot generate non-overlaping conformation. Increase MAXNIT.'
- write (*,'(a)')
- & 'Cannot generate non-overlaping conformation. Increase MAXNIT.'
- return1
- endif
- endif
- else
- back=.false.
- nit=0
- i=i+1
- endif
- niter=niter+1
- enddo
- if (niter.ge.maxgen) then
- write (iout,'(a,2i5)')
- & 'Too many trials in conformation generation',niter,maxgen
- write (*,'(a,2i5)')
- & 'Too many trials in conformation generation',niter,maxgen
- return1
- endif
- do j=1,3
- c(j,nres+1)=c(j,1)
- c(j,nres+nres)=c(j,nres)
- enddo
- return
- end
-c-------------------------------------------------------------------------
- logical function overlap(i)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- data redfac /0.5D0/
- overlap=.false.
- iti=itype(i)
- if (iti.gt.ntyp) return
-C Check for SC-SC overlaps.
-cd print *,'nnt=',nnt,' nct=',nct
- do j=nnt,i-1
- itj=itype(j)
- if (j.lt.i-1 .or. ipot.ne.4) then
- rcomp=sigmaii(iti,itj)
- else
- rcomp=sigma(iti,itj)
- endif
-cd print *,'j=',j
- if (dist(nres+i,nres+j).lt.redfac*rcomp) then
- overlap=.true.
-c print *,'overlap, SC-SC: i=',i,' j=',j,
-c & ' dist=',dist(nres+i,nres+j),' rcomp=',
-c & rcomp
- return
- endif
- enddo
-C Check for overlaps between the added peptide group and the preceding
-C SCs.
- iteli=itel(i)
- do j=1,3
- c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1))
- enddo
- do j=nnt,i-2
- itj=itype(j)
-cd print *,'overlap, p-Sc: i=',i,' j=',j,
-cd & ' dist=',dist(nres+j,maxres2+1)
- if (dist(nres+j,maxres2+1).lt.4.0D0*redfac) then
- overlap=.true.
- return
- endif
- enddo
-C Check for overlaps between the added side chain and the preceding peptide
-C groups.
- do j=1,nnt-2
- do k=1,3
- c(k,maxres2+1)=0.5D0*(c(k,j)+c(k,j+1))
- enddo
-cd print *,'overlap, SC-p: i=',i,' j=',j,
-cd & ' dist=',dist(nres+i,maxres2+1)
- if (dist(nres+i,maxres2+1).lt.4.0D0*redfac) then
- overlap=.true.
- return
- endif
- enddo
-C Check for p-p overlaps
- do j=1,3
- c(j,maxres2+2)=0.5D0*(c(j,i)+c(j,i+1))
- enddo
- do j=nnt,i-2
- itelj=itel(j)
- do k=1,3
- c(k,maxres2+2)=0.5D0*(c(k,j)+c(k,j+1))
- enddo
-cd print *,'overlap, p-p: i=',i,' j=',j,
-cd & ' dist=',dist(maxres2+1,maxres2+2)
- if(iteli.ne.0.and.itelj.ne.0)then
- if (dist(maxres2+1,maxres2+2).lt.rpp(iteli,itelj)*redfac) then
- overlap=.true.
- return
- endif
- endif
- enddo
- return
- end
-c--------------------------------------------------------------------------
- double precision function gen_phi(i,it1,it2)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.BOUNDS'
-c gen_phi=ran_number(-pi,pi)
-C 8/13/98 Generate phi using pre-defined boundaries
- gen_phi=ran_number(phibound(1,i),phibound(2,i))
- return
- end
-c---------------------------------------------------------------------------
- double precision function gen_theta(it,gama,gama1)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
- double precision y(2),z(2)
- double precision theta_max,theta_min
-c print *,'gen_theta: it=',it
- theta_min=0.05D0*pi
- theta_max=0.95D0*pi
- if (dabs(gama).gt.dwapi) then
- y(1)=dcos(gama)
- y(2)=dsin(gama)
- else
- y(1)=0.0D0
- y(2)=0.0D0
- endif
- if (dabs(gama1).gt.dwapi) then
- z(1)=dcos(gama1)
- z(2)=dsin(gama1)
- else
- z(1)=0.0D0
- z(2)=0.0D0
- endif
- thet_pred_mean=a0thet(it)
- do k=1,2
- thet_pred_mean=thet_pred_mean+athet(k,it)*y(k)+bthet(k,it)*z(k)
- enddo
- sig=polthet(3,it)
- do j=2,0,-1
- sig=sig*thet_pred_mean+polthet(j,it)
- enddo
- sig=0.5D0/(sig*sig+sigc0(it))
- ak=dexp(gthet(1,it)-
- &0.5D0*((gthet(2,it)-thet_pred_mean)/gthet(3,it))**2)
-c print '(i5,5(1pe14.4))',it,(gthet(j,it),j=1,3)
-c print '(5(1pe14.4))',thet_pred_mean,theta0(it),sig,sig0(it),ak
- theta_temp=binorm(thet_pred_mean,theta0(it),sig,sig0(it),ak)
- if (theta_temp.lt.theta_min) theta_temp=theta_min
- if (theta_temp.gt.theta_max) theta_temp=theta_max
- gen_theta=theta_temp
-c print '(a)','Exiting GENTHETA.'
- return
- end
-c-------------------------------------------------------------------------
- subroutine gen_side(it,the,al,om,fail)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision MaxBoxLen /10.0D0/
- double precision Ap_inv(3,3),a(3,3),z(3,maxlob),W1(maxlob),
- & sumW(0:maxlob),y(2),cm(2),eig(2),box(2,2),work(100),detAp(maxlob)
- double precision eig_limit /1.0D-8/
- double precision Big /10.0D0/
- double precision vec(3,3)
- logical lprint,fail,lcheck
- lcheck=.false.
- lprint=.false.
- fail=.false.
- if (the.eq.0.0D0 .or. the.eq.pi) then
-#ifdef MPI
- write (*,'(a,i4,a,i3,a,1pe14.5)')
- & 'CG Processor:',me,' Error in GenSide: it=',it,' theta=',the
-#else
-cd write (iout,'(a,i3,a,1pe14.5)')
-cd & 'Error in GenSide: it=',it,' theta=',the
-#endif
- fail=.true.
- return
- endif
- tant=dtan(the-pipol)
- nlobit=nlob(it)
- if (lprint) then
-#ifdef MPI
- print '(a,i4,a)','CG Processor:',me,' Enter Gen_Side.'
- write (iout,'(a,i4,a)') 'Processor:',me,' Enter Gen_Side.'
-#endif
- print *,'it=',it,' nlobit=',nlobit,' the=',the,' tant=',tant
- write (iout,*) 'it=',it,' nlobit=',nlobit,' the=',the,
- & ' tant=',tant
- endif
- do i=1,nlobit
- zz1=tant-censc(1,i,it)
- do k=1,3
- do l=1,3
- a(k,l)=gaussc(k,l,i,it)
- enddo
- enddo
- detApi=a(2,2)*a(3,3)-a(2,3)**2
- Ap_inv(2,2)=a(3,3)/detApi
- Ap_inv(2,3)=-a(2,3)/detApi
- Ap_inv(3,2)=Ap_inv(2,3)
- Ap_inv(3,3)=a(2,2)/detApi
- if (lprint) then
- write (*,'(/a,i2/)') 'Cluster #',i
- write (*,'(3(1pe14.5),5x,1pe14.5)')
- & ((a(l,k),l=1,3),censc(k,i,it),k=1,3)
- write (iout,'(/a,i2/)') 'Cluster #',i
- write (iout,'(3(1pe14.5),5x,1pe14.5)')
- & ((a(l,k),l=1,3),censc(k,i,it),k=1,3)
- endif
- W1i=0.0D0
- do k=2,3
- do l=2,3
- W1i=W1i+a(k,1)*a(l,1)*Ap_inv(k,l)
- enddo
- enddo
- W1i=a(1,1)-W1i
- W1(i)=dexp(bsc(i,it)-0.5D0*W1i*zz1*zz1)
-c if (lprint) write(*,'(a,3(1pe15.5)/)')
-c & 'detAp, W1, anormi',detApi,W1i,anormi
- do k=2,3
- zk=censc(k,i,it)
- do l=2,3
- zk=zk+zz1*Ap_inv(k,l)*a(l,1)
- enddo
- z(k,i)=zk
- enddo
- detAp(i)=dsqrt(detApi)
- enddo
-
- if (lprint) then
- print *,'W1:',(w1(i),i=1,nlobit)
- print *,'detAp:',(detAp(i),i=1,nlobit)
- print *,'Z'
- do i=1,nlobit
- print '(i2,3f10.5)',i,(rad2deg*z(j,i),j=2,3)
- enddo
- write (iout,*) 'W1:',(w1(i),i=1,nlobit)
- write (iout,*) 'detAp:',(detAp(i),i=1,nlobit)
- write (iout,*) 'Z'
- do i=1,nlobit
- write (iout,'(i2,3f10.5)') i,(rad2deg*z(j,i),j=2,3)
- enddo
- endif
- if (lcheck) then
-C Writing the distribution just to check the procedure
- fac=0.0D0
- dV=deg2rad**2*10.0D0
- sum=0.0D0
- sum1=0.0D0
- do i=1,nlobit
- fac=fac+W1(i)/detAp(i)
- enddo
- fac=1.0D0/(2.0D0*fac*pi)
-cd print *,it,'fac=',fac
- do ial=90,180,2
- y(1)=deg2rad*ial
- do iom=-180,180,5
- y(2)=deg2rad*iom
- wart=0.0D0
- do i=1,nlobit
- do j=2,3
- do k=2,3
- a(j-1,k-1)=gaussc(j,k,i,it)
- enddo
- enddo
- y2=y(2)
-
- do iii=-1,1
-
- y(2)=y2+iii*dwapi
-
- wykl=0.0D0
- do j=1,2
- do k=1,2
- wykl=wykl+a(j,k)*(y(j)-z(j+1,i))*(y(k)-z(k+1,i))
- enddo
- enddo
- wart=wart+W1(i)*dexp(-0.5D0*wykl)
-
- enddo
-
- y(2)=y2
-
- enddo
-c print *,'y',y(1),y(2),' fac=',fac
- wart=fac*wart
- write (20,'(2f10.3,1pd15.5)') y(1)*rad2deg,y(2)*rad2deg,wart
- sum=sum+wart
- sum1=sum1+1.0D0
- enddo
- enddo
-c print *,'it=',it,' sum=',sum*dV,' sum1=',sum1*dV
- return
- endif
-
-C Calculate the CM of the system
-C
- do i=1,nlobit
- W1(i)=W1(i)/detAp(i)
- enddo
- sumW(0)=0.0D0
- do i=1,nlobit
- sumW(i)=sumW(i-1)+W1(i)
- enddo
- cm(1)=z(2,1)*W1(1)
- cm(2)=z(3,1)*W1(1)
- do j=2,nlobit
- cm(1)=cm(1)+z(2,j)*W1(j)
- cm(2)=cm(2)+W1(j)*(z(3,1)+pinorm(z(3,j)-z(3,1)))
- enddo
- cm(1)=cm(1)/sumW(nlobit)
- cm(2)=cm(2)/sumW(nlobit)
- if (cm(1).gt.Big .or. cm(1).lt.-Big .or.
- & cm(2).gt.Big .or. cm(2).lt.-Big) then
-cd write (iout,'(a)')
-cd & 'Unexpected error in GenSide - CM coordinates too large.'
-cd write (iout,'(i5,2(1pe14.5))') it,cm(1),cm(2)
-cd write (*,'(a)')
-cd & 'Unexpected error in GenSide - CM coordinates too large.'
-cd write (*,'(i5,2(1pe14.5))') it,cm(1),cm(2)
- fail=.true.
- return
- endif
-cd print *,'CM:',cm(1),cm(2)
-C
-C Find the largest search distance from CM
-C
- radmax=0.0D0
- do i=1,nlobit
- do j=2,3
- do k=2,3
- a(j-1,k-1)=gaussc(j,k,i,it)
- enddo
- enddo
-#ifdef NAG
- call f02faf('N','U',2,a,3,eig,work,100,ifail)
-#else
- call djacob(2,3,10000,1.0d-10,a,vec,eig)
-#endif
-#ifdef MPI
- if (lprint) then
- print *,'*************** CG Processor',me
- print *,'CM:',cm(1),cm(2)
- write (iout,*) '*************** CG Processor',me
- write (iout,*) 'CM:',cm(1),cm(2)
- print '(A,8f10.5)','Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2)
- write (iout,'(A,8f10.5)')
- & 'Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2)
- endif
-#endif
- if (eig(1).lt.eig_limit) then
- write(iout,'(a)')
- & 'From Mult_Norm: Eigenvalues of A are too small.'
- write(*,'(a)')
- & 'From Mult_Norm: Eigenvalues of A are too small.'
- fail=.true.
- return
- endif
- radius=0.0D0
-cd print *,'i=',i
- do j=1,2
- radius=radius+pinorm(z(j+1,i)-cm(j))**2
- enddo
- radius=dsqrt(radius)+3.0D0/dsqrt(eig(1))
- if (radius.gt.radmax) radmax=radius
- enddo
- if (radmax.gt.pi) radmax=pi
-C
-C Determine the boundaries of the search rectangle.
-C
- if (lprint) then
- print '(a,4(1pe14.4))','W1: ',(W1(i),i=1,nlob(it) )
- print '(a,4(1pe14.4))','radmax: ',radmax
- endif
- box(1,1)=dmax1(cm(1)-radmax,0.0D0)
- box(2,1)=dmin1(cm(1)+radmax,pi)
- box(1,2)=cm(2)-radmax
- box(2,2)=cm(2)+radmax
- if (lprint) then
-#ifdef MPI
- print *,'CG Processor',me,' Array BOX:'
-#else
- print *,'Array BOX:'
-#endif
- print '(4(1pe14.4))',((box(k,j),k=1,2),j=1,2)
- print '(a,4(1pe14.4))','sumW: ',(sumW(i),i=0,nlob(it) )
-#ifdef MPI
- write (iout,*)'CG Processor',me,' Array BOX:'
-#else
- write (iout,*)'Array BOX:'
-#endif
- write(iout,'(4(1pe14.4))') ((box(k,j),k=1,2),j=1,2)
- write(iout,'(a,4(1pe14.4))')'sumW: ',(sumW(i),i=0,nlob(it) )
- endif
- if (box(1,2).lt.-MaxBoxLen .or. box(2,2).gt.MaxBoxLen) then
-#ifdef MPI
- write (iout,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.'
- write (*,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.'
-#else
-c write (iout,'(a)') 'Bad sampling box.'
-#endif
- fail=.true.
- return
- endif
- which_lobe=ran_number(0.0D0,sumW(nlobit))
-c print '(a,1pe14.4)','which_lobe=',which_lobe
- do i=1,nlobit
- if (sumW(i-1).le.which_lobe .and. sumW(i).ge.which_lobe) goto 1
- enddo
- 1 ilob=i
-c print *,'ilob=',ilob,' nlob=',nlob(it)
- do i=2,3
- cm(i-1)=z(i,ilob)
- do j=2,3
- a(i-1,j-1)=gaussc(i,j,ilob,it)
- enddo
- enddo
-cd print '(a,i4,a)','CG Processor',me,' Calling MultNorm1.'
- call mult_norm1(3,2,a,cm,box,y,fail)
- if (fail) return
- al=y(1)
- om=pinorm(y(2))
-cd print *,'al=',al,' om=',om
-cd stop
- return
- end
-c---------------------------------------------------------------------------
- double precision function ran_number(x1,x2)
-C Calculate a random real number from the range (x1,x2).
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- double precision x1,x2,fctor
- data fctor /2147483647.0D0/
-#ifdef MPI
- include "mpif.h"
- include 'COMMON.SETUP'
- ran_number=x1+(x2-x1)*prng_next(me)
-#else
- call vrnd(ix,1)
- ran_number=x1+(x2-x1)*ix/fctor
-#endif
- return
- end
-c--------------------------------------------------------------------------
- integer function iran_num(n1,n2)
-C Calculate a random integer number from the range (n1,n2).
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- integer n1,n2,ix
- real fctor /2147483647.0/
-#ifdef MPI
- include "mpif.h"
- include 'COMMON.SETUP'
- ix=n1+(n2-n1+1)*prng_next(me)
- if (ix.lt.n1) ix=n1
- if (ix.gt.n2) ix=n2
- iran_num=ix
-#else
- call vrnd(ix,1)
- ix=n1+(n2-n1+1)*(ix/fctor)
- if (ix.gt.n2) ix=n2
- iran_num=ix
-#endif
- return
- end
-c--------------------------------------------------------------------------
- double precision function binorm(x1,x2,sigma1,sigma2,ak)
- implicit real*8 (a-h,o-z)
-c print '(a)','Enter BINORM.'
- alowb=dmin1(x1-3.0D0*sigma1,x2-3.0D0*sigma2)
- aupb=dmax1(x1+3.0D0*sigma1,x2+3.0D0*sigma2)
- seg=sigma1/(sigma1+ak*sigma2)
- alen=ran_number(0.0D0,1.0D0)
- if (alen.lt.seg) then
- binorm=anorm_distr(x1,sigma1,alowb,aupb)
- else
- binorm=anorm_distr(x2,sigma2,alowb,aupb)
- endif
-c print '(a)','Exiting BINORM.'
- return
- end
-c-----------------------------------------------------------------------
-c double precision function anorm_distr(x,sigma,alowb,aupb)
-c implicit real*8 (a-h,o-z)
-c print '(a)','Enter ANORM_DISTR.'
-c 10 y=ran_number(alowb,aupb)
-c expon=dexp(-0.5D0*((y-x)/sigma)**2)
-c ran=ran_number(0.0D0,1.0D0)
-c if (expon.lt.ran) goto 10
-c anorm_distr=y
-c print '(a)','Exiting ANORM_DISTR.'
-c return
-c end
-c-----------------------------------------------------------------------
- double precision function anorm_distr(x,sigma,alowb,aupb)
- implicit real*8 (a-h,o-z)
-c to make a normally distributed deviate with zero mean and unit variance
-c
- integer iset
- real fac,gset,rsq,v1,v2,ran1
- save iset,gset
- data iset/0/
- if(iset.eq.0) then
-1 v1=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0
- v2=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0
- rsq=v1**2+v2**2
- if(rsq.ge.1.d0.or.rsq.eq.0.0d0) goto 1
- fac=sqrt(-2.0d0*log(rsq)/rsq)
- gset=v1*fac
- gaussdev=v2*fac
- iset=1
- else
- gaussdev=gset
- iset=0
- endif
- anorm_distr=x+gaussdev*sigma
- return
- end
-c------------------------------------------------------------------------
- subroutine mult_norm(lda,n,a,x,fail)
-C
-C Generate the vector X whose elements obey the multiple-normal distribution
-C from exp(-0.5*X'AX). LDA is the leading dimension of the moment matrix A,
-C n is the dimension of the problem. FAIL is set at .TRUE., if the smallest
-C eigenvalue of the matrix A is close to 0.
-C
- implicit double precision (a-h,o-z)
- double precision a(lda,n),x(n),eig(100),vec(3,3),work(100)
- double precision eig_limit /1.0D-8/
- logical fail
- fail=.false.
-c print '(a)','Enter MULT_NORM.'
-C
-C Find the smallest eigenvalue of the matrix A.
-C
-c do i=1,n
-c print '(8f10.5)',(a(i,j),j=1,n)
-c enddo
-#ifdef NAG
- call f02faf('V','U',2,a,lda,eig,work,100,ifail)
-#else
- call djacob(2,lda,10000,1.0d-10,a,vec,eig)
-#endif
-c print '(8f10.5)',(eig(i),i=1,n)
-C print '(a)'
-c do i=1,n
-c print '(8f10.5)',(a(i,j),j=1,n)
-c enddo
- if (eig(1).lt.eig_limit) then
- print *,'From Mult_Norm: Eigenvalues of A are too small.'
- fail=.true.
- return
- endif
-C
-C Generate points following the normal distributions along the principal
-C axes of the moment matrix. Store in WORK.
-C
- do i=1,n
- sigma=1.0D0/dsqrt(eig(i))
- alim=-3.0D0*sigma
- work(i)=anorm_distr(0.0D0,sigma,-alim,alim)
- enddo
-C
-C Transform the vector of normal variables back to the original basis.
-C
- do i=1,n
- xi=0.0D0
- do j=1,n
- xi=xi+a(i,j)*work(j)
- enddo
- x(i)=xi
- enddo
- return
- end
-c------------------------------------------------------------------------
- subroutine mult_norm1(lda,n,a,z,box,x,fail)
-C
-C Generate the vector X whose elements obey the multi-gaussian multi-dimensional
-C distribution from sum_{i=1}^m W(i)exp[-0.5*X'(i)A(i)X(i)]. LDA is the
-C leading dimension of the moment matrix A, n is the dimension of the
-C distribution, nlob is the number of lobes. FAIL is set at .TRUE., if the
-C smallest eigenvalue of the matrix A is close to 0.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- double precision a(lda,n),z(n),x(n),box(n,n)
- double precision etmp
- include 'COMMON.IOUNITS'
-#ifdef MP
- include 'COMMON.SETUP'
-#endif
- logical fail
-C
-C Generate points following the normal distributions along the principal
-C axes of the moment matrix. Store in WORK.
-C
-cd print *,'CG Processor',me,' entered MultNorm1.'
-cd print '(2(1pe14.4),3x,1pe14.4)',((a(i,j),j=1,2),z(i),i=1,2)
-cd do i=1,n
-cd print *,i,box(1,i),box(2,i)
-cd enddo
- istep = 0
- 10 istep = istep + 1
- if (istep.gt.10000) then
-c write (iout,'(a,i4,2a)') 'CG Processor: ',me,': too many steps',
-c & ' in MultNorm1.'
-c write (*,'(a,i4,2a)') 'CG Processor: ',me,': too many steps',
-c & ' in MultNorm1.'
-c write (iout,*) 'box',box
-c write (iout,*) 'a',a
-c write (iout,*) 'z',z
- fail=.true.
- return
- endif
- do i=1,n
- x(i)=ran_number(box(1,i),box(2,i))
- enddo
- ww=0.0D0
- do i=1,n
- xi=pinorm(x(i)-z(i))
- ww=ww+0.5D0*a(i,i)*xi*xi
- do j=i+1,n
- ww=ww+a(i,j)*xi*pinorm(x(j)-z(j))
- enddo
- enddo
- dec=ran_number(0.0D0,1.0D0)
-c print *,(x(i),i=1,n),ww,dexp(-ww),dec
-crc if (dec.gt.dexp(-ww)) goto 10
- if(-ww.lt.100) then
- etmp=dexp(-ww)
- else
- return
- endif
- if (dec.gt.etmp) goto 10
-cd print *,'CG Processor',me,' exitting MultNorm1.'
- return
- end
-c
-crc--------------------------------------
- subroutine overlap_sc(scfail)
-c Internal and cartesian coordinates must be consistent as input,
-c and will be up-to-date on return.
-c At the end of this procedure, scfail is true if there are
-c overlapping residues left, or false otherwise (success)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.VAR'
- include 'COMMON.SBRIDGE'
- include 'COMMON.IOUNITS'
- logical had_overlaps,fail,scfail
- integer ioverlap(maxres),ioverlap_last
-
- had_overlaps=.false.
- call overlap_sc_list(ioverlap,ioverlap_last)
- if (ioverlap_last.gt.0) then
- write (iout,*) '#OVERLAPing residues ',ioverlap_last
- write (iout,'(20i4)') (ioverlap(k),k=1,ioverlap_last)
- had_overlaps=.true.
- endif
-
- maxsi=1000
- do k=1,1000
- if (ioverlap_last.eq.0) exit
-
- do ires=1,ioverlap_last
- i=ioverlap(ires)
- iti=itype(i)
- if (iti.ne.10) then
- nsi=0
- fail=.true.
- do while (fail.and.nsi.le.maxsi)
- call gen_side(iti,theta(i+1),alph(i),omeg(i),fail)
- nsi=nsi+1
- enddo
- if(fail) goto 999
- endif
- enddo
-
- call chainbuild
- call overlap_sc_list(ioverlap,ioverlap_last)
-c write (iout,*) 'Overlaping residues ',ioverlap_last,
-c & (ioverlap(j),j=1,ioverlap_last)
- enddo
-
- if (k.le.1000.and.ioverlap_last.eq.0) then
- scfail=.false.
- if (had_overlaps) then
- write (iout,*) '#OVERLAPing all corrected after ',k,
- & ' random generation'
- endif
- else
- scfail=.true.
- write (iout,*) '#OVERLAPing NOT all corrected ',ioverlap_last
- write (iout,'(20i4)') (ioverlap(j),j=1,ioverlap_last)
- endif
-
- return
-
- 999 continue
- write (iout,'(a30,i5,a12,i4)')
- & '#OVERLAP FAIL in gen_side after',maxsi,
- & 'iter for RES',i
- scfail=.true.
- return
- end
-
- subroutine overlap_sc_list(ioverlap,ioverlap_last)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.VAR'
- include 'COMMON.CALC'
- logical fail
- integer ioverlap(maxres),ioverlap_last
- data redfac /0.5D0/
-
- ioverlap_last=0
-C Check for SC-SC overlaps and mark residues
-c print *,'>>overlap_sc nnt=',nnt,' nct=',nct
- ind=0
- do i=iatsc_s,iatsc_e
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=dsc_inv(itypi)
-c
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- ind=ind+1
- itypj=itype(j)
- dscj_inv=dsc_inv(itypj)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
- if (j.gt.i+1) then
- rcomp=sigmaii(itypi,itypj)
- else
- rcomp=sigma(itypi,itypj)
- endif
-c print '(2(a3,2i3),a3,2f10.5)',
-c & ' i=',i,iti,' j=',j,itj,' d=',dist(nres+i,nres+j)
-c & ,rcomp
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-
-ct if ( 1.0/rij .lt. redfac*rcomp .or.
-ct & rij_shift.le.0.0D0 ) then
- if ( rij_shift.le.0.0D0 ) then
-cd write (iout,'(a,i3,a,i3,a,f10.5,a,3f10.5)')
-cd & 'overlap SC-SC: i=',i,' j=',j,
-cd & ' dist=',dist(nres+i,nres+j),' rcomp=',
-cd & rcomp,1.0/rij,rij_shift
- ioverlap_last=ioverlap_last+1
- ioverlap(ioverlap_last)=i
- do k=1,ioverlap_last-1
- if (ioverlap(k).eq.i) ioverlap_last=ioverlap_last-1
- enddo
- ioverlap_last=ioverlap_last+1
- ioverlap(ioverlap_last)=j
- do k=1,ioverlap_last-1
- if (ioverlap(k).eq.j) ioverlap_last=ioverlap_last-1
- enddo
- endif
- enddo
- enddo
- enddo
- return
- end
+++ /dev/null
- subroutine pdbout(etot,tytul,iunit)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.HEADER'
- include 'COMMON.SBRIDGE'
- include 'COMMON.DISTFIT'
- include 'COMMON.MD'
- character*50 tytul
- dimension ica(maxres)
- write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
-cmodel write (iunit,'(a5,i6)') 'MODEL',1
- if (nhfrag.gt.0) then
- do j=1,nhfrag
- iti=itype(hfrag(1,j))
- itj=itype(hfrag(2,j))
- if (j.lt.10) then
- write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
- & 'HELIX',j,'H',j,
- & restyp(iti),hfrag(1,j)-1,
- & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
- else
- write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)')
- & 'HELIX',j,'H',j,
- & restyp(iti),hfrag(1,j)-1,
- & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
- endif
- enddo
- endif
-
- if (nbfrag.gt.0) then
-
- do j=1,nbfrag
-
- iti=itype(bfrag(1,j))
- itj=itype(bfrag(2,j)-1)
-
- write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
- & 'SHEET',1,'B',j,2,
- & restyp(iti),bfrag(1,j)-1,
- & restyp(itj),bfrag(2,j)-2,0
-
- if (bfrag(3,j).gt.bfrag(4,j)) then
-
- itk=itype(bfrag(3,j))
- itl=itype(bfrag(4,j)+1)
-
- write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
- & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
- & 'SHEET',2,'B',j,2,
- & restyp(itl),bfrag(4,j),
- & restyp(itk),bfrag(3,j)-1,-1,
- & "N",restyp(itk),bfrag(3,j)-1,
- & "O",restyp(iti),bfrag(1,j)-1
-
- else
-
- itk=itype(bfrag(3,j))
- itl=itype(bfrag(4,j)-1)
-
-
- write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
- & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
- & 'SHEET',2,'B',j,2,
- & restyp(itk),bfrag(3,j)-1,
- & restyp(itl),bfrag(4,j)-2,1,
- & "N",restyp(itk),bfrag(3,j)-1,
- & "O",restyp(iti),bfrag(1,j)-1
-
-
-
- endif
-
- enddo
- endif
-
- if (nss.gt.0) then
- do i=1,nss
- if (dyn_ss) then
- write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
- & 'SSBOND',i,'CYS',idssb(i)-nnt+1,
- & 'CYS',jdssb(i)-nnt+1
- else
- write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
- & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres,
- & 'CYS',jhpb(i)-nnt+1-nres
- endif
- enddo
- endif
-
- iatom=0
- do i=nnt,nct
- ires=i-nnt+1
- iatom=iatom+1
- ica(i)=iatom
- iti=itype(i)
- write (iunit,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),vtot(i)
- if (iti.ne.10) then
- iatom=iatom+1
- write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3),
- & vtot(i+nres)
- endif
- enddo
- write (iunit,'(a)') 'TER'
- do i=nnt,nct-1
- if (itype(i).eq.10) then
- write (iunit,30) ica(i),ica(i+1)
- else
- write (iunit,30) ica(i),ica(i+1),ica(i)+1
- endif
- enddo
- if (itype(nct).ne.10) then
- write (iunit,30) ica(nct),ica(nct)+1
- endif
- do i=1,nss
- if (dyn_ss) then
- write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1
- else
- write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
- endif
- enddo
- write (iunit,'(a6)') 'ENDMDL'
- 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3,f15.3)
- 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.3,f15.3)
- 30 FORMAT ('CONECT',8I5)
- return
- end
-c------------------------------------------------------------------------------
- subroutine MOL2out(etot,tytul)
-C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
-C format.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.HEADER'
- include 'COMMON.SBRIDGE'
- character*32 tytul,fd
- character*3 zahl
- character*6 res_num,pom,ucase
-#ifdef AIX
- call fdate_(fd)
-#elif (defined CRAY)
- call date(fd)
-#else
- call fdate(fd)
-#endif
- write (imol2,'(a)') '#'
- write (imol2,'(a)')
- & '# Creating user name: unres'
- write (imol2,'(2a)') '# Creation time: ',
- & fd
- write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
- write (imol2,'(a)') tytul
- write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
- write (imol2,'(a)') 'SMALL'
- write (imol2,'(a)') 'USER_CHARGES'
- write (imol2,'(a)') '\@<TRIPOS>ATOM'
- do i=nnt,nct
- write (zahl,'(i3)') i
- pom=ucase(restyp(itype(i)))
- res_num = pom(:3)//zahl(2:)
- write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
- enddo
- write (imol2,'(a)') '\@<TRIPOS>BOND'
- do i=nnt,nct-1
- write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
- enddo
- do i=1,nss
- write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
- enddo
- write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
- do i=nnt,nct
- write (zahl,'(i3)') i
- pom = ucase(restyp(itype(i)))
- res_num = pom(:3)//zahl(2:)
- write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
- enddo
- 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
- 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
- return
- end
-c------------------------------------------------------------------------
- subroutine intout
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- write (iout,'(/a)') 'Geometry of the virtual chain.'
- write (iout,'(7a)') ' Res ',' d',' Theta',
- & ' Gamma',' Dsc',' Alpha',' Beta '
- do i=1,nres
- iti=itype(i)
- write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
- & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
- & rad2deg*omeg(i)
- enddo
- return
- end
-c---------------------------------------------------------------------------
- subroutine briefout(it,ener)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.SBRIDGE'
-c print '(a,i5)',intname,igeom
-#if defined(AIX) || defined(PGI)
- open (igeom,file=intname,position='append')
-#else
- open (igeom,file=intname,access='append')
-#endif
- IF (NSS.LE.9) THEN
- WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
- ELSE
- WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
- WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
- ENDIF
-c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
- WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
- WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
-c if (nvar.gt.nphi+ntheta) then
- write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
- write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
-c endif
- close(igeom)
- 180 format (I5,F12.3,I2,9(1X,2I3))
- 190 format (3X,11(1X,2I3))
- 200 format (8F10.4)
- return
- end
-#ifdef WINIFL
- subroutine fdate(fd)
- character*32 fd
- write(fd,'(32x)')
- return
- end
-#endif
-c----------------------------------------------------------------
-#ifdef NOXDR
- subroutine cartout(time)
-#else
- subroutine cartoutx(time)
-#endif
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.HEADER'
- include 'COMMON.SBRIDGE'
- include 'COMMON.DISTFIT'
- include 'COMMON.MD'
- double precision time
-#if defined(AIX) || defined(PGI)
- open(icart,file=cartname,position="append")
-#else
- open(icart,file=cartname,access="append")
-#endif
- write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
- if (dyn_ss) then
- write (icart,'(i4,$)')
- & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss)
- else
- write (icart,'(i4,$)')
- & nss,(ihpb(j),jhpb(j),j=1,nss)
- endif
- write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back,
- & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair),
- & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
- write (icart,'(8f10.5)')
- & ((c(k,j),k=1,3),j=1,nres),
- & ((c(k,j+nres),k=1,3),j=nnt,nct)
- close(icart)
- return
- end
-c-----------------------------------------------------------------
-#ifndef NOXDR
- subroutine cartout(time)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- include 'COMMON.SETUP'
-#else
- parameter (me=0)
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.HEADER'
- include 'COMMON.SBRIDGE'
- include 'COMMON.DISTFIT'
- include 'COMMON.MD'
- double precision time
- integer iret,itmp
- real xcoord(3,maxres2+2),prec
-
-#ifdef AIX
- call xdrfopen_(ixdrf,cartname, "a", iret)
- call xdrffloat_(ixdrf, real(time), iret)
- call xdrffloat_(ixdrf, real(potE), iret)
- call xdrffloat_(ixdrf, real(uconst), iret)
- call xdrffloat_(ixdrf, real(uconst_back), iret)
- call xdrffloat_(ixdrf, real(t_bath), iret)
- call xdrfint_(ixdrf, nss, iret)
- do j=1,nss
- if (dyn_ss) then
- call xdrfint_(ixdrf, idssb(j)+nres, iret)
- call xdrfint_(ixdrf, jdssb(j)+nres, iret)
- else
- call xdrfint_(ixdrf, ihpb(j), iret)
- call xdrfint_(ixdrf, jhpb(j), iret)
- endif
- enddo
- call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
- do i=1,nfrag
- call xdrffloat_(ixdrf, real(qfrag(i)), iret)
- enddo
- do i=1,npair
- call xdrffloat_(ixdrf, real(qpair(i)), iret)
- enddo
- do i=1,nfrag_back
- call xdrffloat_(ixdrf, real(utheta(i)), iret)
- call xdrffloat_(ixdrf, real(ugamma(i)), iret)
- call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
- enddo
-#else
- call xdrfopen(ixdrf,cartname, "a", iret)
- call xdrffloat(ixdrf, real(time), iret)
- call xdrffloat(ixdrf, real(potE), iret)
- call xdrffloat(ixdrf, real(uconst), iret)
- call xdrffloat(ixdrf, real(uconst_back), iret)
- call xdrffloat(ixdrf, real(t_bath), iret)
- call xdrfint(ixdrf, nss, iret)
- do j=1,nss
- if (dyn_ss) then
- call xdrfint(ixdrf, idssb(j)+nres, iret)
- call xdrfint(ixdrf, jdssb(j)+nres, iret)
- else
- call xdrfint(ixdrf, ihpb(j), iret)
- call xdrfint(ixdrf, jhpb(j), iret)
- endif
- enddo
- call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
- do i=1,nfrag
- call xdrffloat(ixdrf, real(qfrag(i)), iret)
- enddo
- do i=1,npair
- call xdrffloat(ixdrf, real(qpair(i)), iret)
- enddo
- do i=1,nfrag_back
- call xdrffloat(ixdrf, real(utheta(i)), iret)
- call xdrffloat(ixdrf, real(ugamma(i)), iret)
- call xdrffloat(ixdrf, real(uscdiff(i)), iret)
- enddo
-#endif
- prec=10000.0
- do i=1,nres
- do j=1,3
- xcoord(j,i)=c(j,i)
- enddo
- enddo
- do i=nnt,nct
- do j=1,3
- xcoord(j,nres+i-nnt+1)=c(j,i+nres)
- enddo
- enddo
-
- itmp=nres+nct-nnt+1
-#ifdef AIX
- call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
- call xdrfclose_(ixdrf, iret)
-#else
- call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
- call xdrfclose(ixdrf, iret)
-#endif
- return
- end
-#endif
-c-----------------------------------------------------------------
- subroutine statout(itime)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.HEADER'
- include 'COMMON.SBRIDGE'
- include 'COMMON.DISTFIT'
- include 'COMMON.MD'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- integer itime
- double precision energia(0:n_ene)
- double precision gyrate
- external gyrate
- common /gucio/ cm
- character*256 line1,line2
- character*4 format1,format2
- character*30 format
-#ifdef AIX
- if(itime.eq.0) then
- open(istat,file=statname,position="append")
- endif
-#else
-#ifdef PGI
- open(istat,file=statname,position="append")
-#else
- open(istat,file=statname,access="append")
-#endif
-#endif
- if (refstr) then
- call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
- if(tnp .or. tnp1 .or. tnh) then
- write (line1,'(i10,f15.2,3f12.3,f12.6,f7.2,4f6.3,3f12.3,i5,$)')
- & itime,totT,EK,potE,totE,hhh,
- & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
- format1="a145"
- else
- write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
- & itime,totT,EK,potE,totE,
- & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
- format1="a133"
- endif
- else
- if(tnp .or. tnp1 .or. tnh) then
- write (line1,'(i10,f15.2,7f12.3,f12.6,i5,$)')
- & itime,totT,EK,potE,totE,hhh,
- & amax,kinetic_T,t_bath,gyrate(),me
- format1="a126"
- else
- write (line1,'(i10,f15.2,7f12.3,i5,$)')
- & itime,totT,EK,potE,totE,
- & amax,kinetic_T,t_bath,gyrate(),me
- format1="a114"
- endif
- endif
- if(usampl.and.totT.gt.eq_time) then
- write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
- & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
- & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
- write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
- & +21*nfrag_back
- elseif(hremd.gt.0) then
- write(line2,'(i5)') iset
- format2="a005"
- else
- format2="a001"
- line2=' '
- endif
- if (print_compon) then
- if(itime.eq.0) then
- write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
- & ",20a12)"
- write (istat,format) "#","",
- & (ename(print_order(i)),i=1,nprint_ene)
- endif
- write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
- & ",20f12.3)"
- write (istat,format) line1,line2,
- & (potEcomp(print_order(i)),i=1,nprint_ene)
- else
- write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
- write (istat,format) line1,line2
- endif
-#if defined(AIX)
- call flush(istat)
-#else
- close(istat)
-#endif
- return
- end
-c---------------------------------------------------------------
- double precision function gyrate()
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.INTERACT'
- include 'COMMON.CHAIN'
- double precision cen(3),rg
-
- do j=1,3
- cen(j)=0.0d0
- enddo
-
- do i=nnt,nct
- do j=1,3
- cen(j)=cen(j)+c(j,i)
- enddo
- enddo
- do j=1,3
- cen(j)=cen(j)/dble(nct-nnt+1)
- enddo
- rg = 0.0d0
- do i = nnt, nct
- do j=1,3
- rg = rg + (c(j,i)-cen(j))**2
- enddo
- end do
- gyrate = sqrt(rg/dble(nct-nnt+1))
- return
- end
-
+++ /dev/null
- double precision function gnmr1(y,ymin,ymax)
- implicit none
- double precision y,ymin,ymax
- double precision wykl /4.0d0/
- if (y.lt.ymin) then
- gnmr1=(ymin-y)**wykl/wykl
- else if (y.gt.ymax) then
- gnmr1=(y-ymax)**wykl/wykl
- else
- gnmr1=0.0d0
- endif
- return
- end
-c------------------------------------------------------------------------------
- double precision function gnmr1prim(y,ymin,ymax)
- implicit none
- double precision y,ymin,ymax
- double precision wykl /4.0d0/
- if (y.lt.ymin) then
- gnmr1prim=-(ymin-y)**(wykl-1)
- else if (y.gt.ymax) then
- gnmr1prim=(y-ymax)**(wykl-1)
- else
- gnmr1prim=0.0d0
- endif
- return
- end
-c------------------------------------------------------------------------------
- double precision function harmonic(y,ymax)
- implicit none
- double precision y,ymax
- double precision wykl /2.0d0/
- harmonic=(y-ymax)**wykl
- return
- end
-c-------------------------------------------------------------------------------
- double precision function harmonicprim(y,ymax)
- double precision y,ymin,ymax
- double precision wykl /2.0d0/
- harmonicprim=(y-ymax)*wykl
- return
- end
-c---------------------------------------------------------------------------------
+++ /dev/null
- subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- include 'COMMON.SCCOR'
- external ufparm
- integer uiparm(1)
- double precision urparm(1)
- dimension x(maxvar),g(maxvar)
-c
-c This subroutine calculates total internal coordinate gradient.
-c Depending on the number of function evaluations, either whole energy
-c is evaluated beforehand, Cartesian coordinates and their derivatives in
-c internal coordinates are reevaluated or only the cartesian-in-internal
-c coordinate derivatives are evaluated. The subroutine was designed to work
-c with SUMSL.
-c
-c
- icg=mod(nf,2)+1
-
-cd print *,'grad',nf,icg
- if (nf-nfl+1) 20,30,40
- 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
-c write (iout,*) 'grad 20'
- if (nf.eq.0) return
- goto 40
- 30 call var_to_geom(n,x)
- call chainbuild
-c write (iout,*) 'grad 30'
-C
-C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-C
- 40 call cartder
-c write (iout,*) 'grad 40'
-c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
-C
-C Convert the Cartesian gradient into internal-coordinate gradient.
-C
- ind=0
- ind1=0
- do i=1,nres-2
- gthetai=0.0D0
- gphii=0.0D0
- do j=i+1,nres-1
- ind=ind+1
-c ind=indmat(i,j)
-c print *,'GRAD: i=',i,' jc=',j,' ind=',ind
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- enddo
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- enddo
- enddo
- do j=i+1,nres-1
- ind1=ind1+1
-c ind1=indmat(i,j)
-c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
- do k=1,3
- gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
- gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
- enddo
- enddo
- if (i.gt.1) g(i-1)=gphii
- if (n.gt.nphi) g(nphi+i)=gthetai
- enddo
- if (n.le.nphi+ntheta) goto 10
- do i=2,nres-1
- if (itype(i).ne.10) then
- galphai=0.0D0
- gomegai=0.0D0
- do k=1,3
- galphai=galphai+dxds(k,i)*gradx(k,i,icg)
- enddo
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
- enddo
- g(ialph(i,1))=galphai
- g(ialph(i,1)+nside)=gomegai
- endif
- enddo
-C
-C Add the components corresponding to local energy terms.
-C
- 10 continue
- do i=1,nvar
-cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
- g(i)=g(i)+gloc(i,icg)
- enddo
-C Uncomment following three lines for diagnostics.
-cd call intout
-cd call briefout(0,0.0d0)
-cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
- return
- end
-C-------------------------------------------------------------------------
- subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- external ufparm
- integer uiparm(1)
- double precision urparm(1)
- dimension x(maxvar),g(maxvar)
-
- icg=mod(nf,2)+1
- if (nf-nfl+1) 20,30,40
- 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm)
-c write (iout,*) 'grad 20'
- if (nf.eq.0) return
- goto 40
- 30 continue
-#ifdef OSF
-c Intercept NaNs in the coordinates
-c write(iout,*) (var(i),i=1,nvar)
- x_sum=0.D0
- do i=1,n
- x_sum=x_sum+x(i)
- enddo
- if (x_sum.ne.x_sum) then
- write(iout,*)" *** grad_restr : Found NaN in coordinates"
- call flush(iout)
- print *," *** grad_restr : Found NaN in coordinates"
- return
- endif
-#endif
- call var_to_geom_restr(n,x)
- call chainbuild
-C
-C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-C
- 40 call cartder
-C
-C Convert the Cartesian gradient into internal-coordinate gradient.
-C
-
- ig=0
- ind=nres-2
- do i=2,nres-2
- IF (mask_phi(i+2).eq.1) THEN
- gphii=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
- enddo
- enddo
- ig=ig+1
- g(ig)=gphii
- ELSE
- ind=ind+nres-1-i
- ENDIF
- enddo
-
-
- ind=0
- do i=1,nres-2
- IF (mask_theta(i+2).eq.1) THEN
- ig=ig+1
- gthetai=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
- enddo
- enddo
- g(ig)=gthetai
- ELSE
- ind=ind+nres-1-i
- ENDIF
- enddo
-
- do i=2,nres-1
- if (itype(i).ne.10) then
- IF (mask_side(i).eq.1) THEN
- ig=ig+1
- galphai=0.0D0
- do k=1,3
- galphai=galphai+dxds(k,i)*gradx(k,i,icg)
- enddo
- g(ig)=galphai
- ENDIF
- endif
- enddo
-
-
- do i=2,nres-1
- if (itype(i).ne.10) then
- IF (mask_side(i).eq.1) THEN
- ig=ig+1
- gomegai=0.0D0
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
- enddo
- g(ig)=gomegai
- ENDIF
- endif
- enddo
-
-C
-C Add the components corresponding to local energy terms.
-C
-
- ig=0
- igall=0
- do i=4,nres
- igall=igall+1
- if (mask_phi(i).eq.1) then
- ig=ig+1
- g(ig)=g(ig)+gloc(igall,icg)
- endif
- enddo
-
- do i=3,nres
- igall=igall+1
- if (mask_theta(i).eq.1) then
- ig=ig+1
- g(ig)=g(ig)+gloc(igall,icg)
- endif
- enddo
-
- do ij=1,2
- do i=2,nres-1
- if (itype(i).ne.10) then
- igall=igall+1
- if (mask_side(i).eq.1) then
- ig=ig+1
- g(ig)=g(ig)+gloc(igall,icg)
- endif
- endif
- enddo
- enddo
-
-cd do i=1,ig
-cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
-cd enddo
- return
- end
-C-------------------------------------------------------------------------
- subroutine cartgrad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.SCCOR'
-c
-c This subrouting calculates total Cartesian coordinate gradient.
-c The subroutine chainbuild_cart and energy MUST be called beforehand.
-c
-c do i=1,nres
-c write (iout,*) "przed sum_grad", gloc_sc(1,i,icg),gloc(i,icg)
-c enddo
-
-#ifdef TIMING
- time00=MPI_Wtime()
-#endif
- icg=1
- call sum_gradient
-#ifdef TIMING
-#endif
-c do i=1,nres
-c write (iout,*) "checkgrad", gloc_sc(1,i,icg),gloc(i,icg)
-c enddo
-cd write (iout,*) "After sum_gradient"
-cd do i=1,nres-1
-cd write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
-cd write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
-cd enddo
-c If performing constraint dynamics, add the gradients of the constraint energy
- if(usampl.and.totT.gt.eq_time) then
- do i=1,nct
- do j=1,3
- gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
- gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
- enddo
- enddo
- do i=1,nres-3
- gloc(i,icg)=gloc(i,icg)+dugamma(i)
- enddo
- do i=1,nres-2
- gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
- enddo
- endif
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call intcartderiv
-#ifdef TIMING
- time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
-#endif
-cd call checkintcartgrad
-cd write(iout,*) 'calling int_to_cart'
-cd write (iout,*) "gcart, gxcart, gloc before int_to_cart"
- do i=1,nct
- do j=1,3
- gcart(j,i)=gradc(j,i,icg)
- gxcart(j,i)=gradx(j,i,icg)
- enddo
-cd write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),
-cd & (gxcart(j,i),j=1,3),gloc(i,icg)
- enddo
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- call int_to_cart
-#ifdef TIMING
- time_inttocart=time_inttocart+MPI_Wtime()-time01
-#endif
-cd write (iout,*) "gcart and gxcart after int_to_cart"
-cd do i=0,nres-1
-cd write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
-cd & (gxcart(j,i),j=1,3)
-cd enddo
-#ifdef TIMING
- time_cartgrad=time_cartgrad+MPI_Wtime()-time00
-#endif
- return
- end
-C-------------------------------------------------------------------------
- subroutine zerograd
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.DERIV'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.SCCOR'
-C
-C Initialize Cartesian-coordinate gradient
-C
- do i=1,nres
- do j=1,3
- gvdwx(j,i)=0.0D0
- gvdwxT(j,i)=0.0D0
- gradx_scp(j,i)=0.0D0
- gvdwc(j,i)=0.0D0
- gvdwcT(j,i)=0.0D0
- gvdwc_scp(j,i)=0.0D0
- gvdwc_scpp(j,i)=0.0d0
- gelc (j,i)=0.0D0
- gelc_long(j,i)=0.0D0
- gradb(j,i)=0.0d0
- gradbx(j,i)=0.0d0
- gvdwpp(j,i)=0.0d0
- gel_loc(j,i)=0.0d0
- gel_loc_long(j,i)=0.0d0
- ghpbc(j,i)=0.0D0
- ghpbx(j,i)=0.0D0
- gcorr3_turn(j,i)=0.0d0
- gcorr4_turn(j,i)=0.0d0
- gradcorr(j,i)=0.0d0
- gradcorr_long(j,i)=0.0d0
- gradcorr5_long(j,i)=0.0d0
- gradcorr6_long(j,i)=0.0d0
- gcorr6_turn_long(j,i)=0.0d0
- gradcorr5(j,i)=0.0d0
- gradcorr6(j,i)=0.0d0
- gcorr6_turn(j,i)=0.0d0
- gsccorc(j,i)=0.0d0
- gsccorx(j,i)=0.0d0
- gradc(j,i,icg)=0.0d0
- gradx(j,i,icg)=0.0d0
- gscloc(j,i)=0.0d0
- gsclocx(j,i)=0.0d0
- do intertyp=1,3
- gloc_sc(intertyp,i,icg)=0.0d0
- enddo
- enddo
- enddo
-C
-C Initialize the gradient of local energy terms.
-C
- do i=1,4*nres
- gloc(i,icg)=0.0D0
- enddo
- do i=1,nres
- gel_loc_loc(i)=0.0d0
- gcorr_loc(i)=0.0d0
- g_corr5_loc(i)=0.0d0
- g_corr6_loc(i)=0.0d0
- gel_loc_turn3(i)=0.0d0
- gel_loc_turn4(i)=0.0d0
- gel_loc_turn6(i)=0.0d0
- gsccor_loc(i)=0.0d0
- enddo
-c initialize gcart and gxcart
- do i=0,nres
- do j=1,3
- gcart(j,i)=0.0d0
- gxcart(j,i)=0.0d0
- enddo
- enddo
- return
- end
-c-------------------------------------------------------------------------
- double precision function fdum()
- fdum=0.0D0
- return
- end
+++ /dev/null
- block data
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.MD'
- data MovTypID
- & /'pool','chain regrow','multi-bond','phi','theta','side chain',
- & 'total'/
-c Conversion from poises to molecular unit and the gas constant
- data cPoise /2.9361d0/, Rb /0.001986d0/
- end
-c--------------------------------------------------------------------------
- subroutine initialize
-C
-C Define constants and zero out tables.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
-#ifndef ISNAN
- external proc_proc
-#ifdef WINPGI
-cMS$ATTRIBUTES C :: proc_proc
-#endif
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.MCM'
- include 'COMMON.MINIM'
- include 'COMMON.DERIV'
- include 'COMMON.SPLITELE'
-c Common blocks from the diagonalization routines
- COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400)
- COMMON /MACHSW/ KDIAG,ICORFL,IXDR
- logical mask_r
-c real*8 text1 /'initial_i'/
-
- mask_r=.false.
-#ifndef ISNAN
-c NaNQ initialization
- i=-1
- arg=100.0d0
- rr=dacos(arg)
-#ifdef WINPGI
- idumm=proc_proc(rr,i)
-#else
- call proc_proc(rr,i)
-#endif
-#endif
-
- kdiag=0
- icorfl=0
- iw=2
-C
-C The following is just to define auxiliary variables used in angle conversion
-C
- pi=4.0D0*datan(1.0D0)
- dwapi=2.0D0*pi
- dwapi3=dwapi/3.0D0
- pipol=0.5D0*pi
- deg2rad=pi/180.0D0
- rad2deg=1.0D0/deg2rad
- angmin=10.0D0*deg2rad
-C
-C Define I/O units.
-C
- inp= 1
- iout= 2
- ipdbin= 3
- ipdb= 7
- icart = 30
- imol2= 4
- igeom= 8
- intin= 9
- ithep= 11
- ithep_pdb=51
- irotam=12
- irotam_pdb=52
- itorp= 13
- itordp= 23
- ielep= 14
- isidep=15
- iscpp=25
- icbase=16
- ifourier=20
- istat= 17
- irest1=55
- irest2=56
- iifrag=57
- ientin=18
- ientout=19
- ibond = 28
- isccor = 29
-crc for write_rmsbank1
- izs1=21
-cdr include secondary structure prediction bias
- isecpred=27
-C
-C CSA I/O units (separated from others especially for Jooyoung)
-C
- icsa_rbank=30
- icsa_seed=31
- icsa_history=32
- icsa_bank=33
- icsa_bank1=34
- icsa_alpha=35
- icsa_alpha1=36
- icsa_bankt=37
- icsa_int=39
- icsa_bank_reminimized=38
- icsa_native_int=41
- icsa_in=40
-crc for ifc error 118
- icsa_pdb=42
-C
-C Set default weights of the energy terms.
-C
- wlong=1.0D0
- welec=1.0D0
- wtor =1.0D0
- wang =1.0D0
- wscloc=1.0D0
- wstrain=1.0D0
-C
-C Zero out tables.
-C
- print '(a,$)','Inside initialize'
-c call memmon_print_usage()
- do i=1,maxres2
- do j=1,3
- c(j,i)=0.0D0
- dc(j,i)=0.0D0
- enddo
- enddo
- do i=1,maxres
- do j=1,3
- xloc(j,i)=0.0D0
- enddo
- enddo
- do i=1,ntyp
- do j=1,ntyp
- aa(i,j)=0.0D0
- bb(i,j)=0.0D0
- augm(i,j)=0.0D0
- sigma(i,j)=0.0D0
- r0(i,j)=0.0D0
- chi(i,j)=0.0D0
- enddo
- do j=1,2
- bad(i,j)=0.0D0
- enddo
- chip(i)=0.0D0
- alp(i)=0.0D0
- sigma0(i)=0.0D0
- sigii(i)=0.0D0
- rr0(i)=0.0D0
- a0thet(i)=0.0D0
- do j=1,2
- athet(j,i)=0.0D0
- bthet(j,i)=0.0D0
- enddo
- do j=0,3
- polthet(j,i)=0.0D0
- enddo
- do j=1,3
- gthet(j,i)=0.0D0
- enddo
- theta0(i)=0.0D0
- sig0(i)=0.0D0
- sigc0(i)=0.0D0
- do j=1,maxlob
- bsc(j,i)=0.0D0
- do k=1,3
- censc(k,j,i)=0.0D0
- enddo
- do k=1,3
- do l=1,3
- gaussc(l,k,j,i)=0.0D0
- enddo
- enddo
- nlob(i)=0
- enddo
- enddo
- nlob(ntyp1)=0
- dsc(ntyp1)=0.0D0
- do i=1,maxtor
- itortyp(i)=0
- do j=1,maxtor
- do k=1,maxterm
- v1(k,j,i)=0.0D0
- v2(k,j,i)=0.0D0
- enddo
- enddo
- enddo
- do i=1,maxres
- itype(i)=0
- itel(i)=0
- enddo
-C Initialize the bridge arrays
- ns=0
- nss=0
- nhpb=0
- do i=1,maxss
- iss(i)=0
- enddo
- do i=1,maxdim
- dhpb(i)=0.0D0
- enddo
- do i=1,maxres
- ihpb(i)=0
- jhpb(i)=0
- enddo
-C
-C Initialize timing.
-C
- call set_timers
-C
-C Initialize variables used in minimization.
-C
-c maxfun=5000
-c maxit=2000
- maxfun=500
- maxit=200
- tolf=1.0D-2
- rtolf=5.0D-4
-C
-C Initialize the variables responsible for the mode of gradient storage.
-C
- nfl=0
- icg=1
-C
-C Initialize constants used to split the energy into long- and short-range
-C components
-C
- r_cut=2.0d0
- rlamb=0.3d0
-#ifndef SPLITELE
- nprint_ene=nprint_ene-1
-#endif
- return
- end
-c-------------------------------------------------------------------------
- block data nazwy
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.NAMES'
- include 'COMMON.FFIELD'
- data restyp /
- &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR',
- &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/
- data onelet /
- &'C','M','F','I','L','V','W','Y','A','G','T',
- &'S','Q','N','E','D','H','R','K','P','X'/
- data potname /'LJ','LJK','BP','GB','GBV'/
- data ename /
- & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ",
- & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ",
- & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ",
- & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," "/
- data wname /
- & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC",
- & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD",
- & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR",
- & " "," "/
- data nprint_ene /20/
- data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16,
- & 21,0,0,0/
- end
-c---------------------------------------------------------------------------
- subroutine init_int_table
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer blocklengths(15),displs(15)
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.TORCNSTR'
- include 'COMMON.IOUNITS'
- include 'COMMON.DERIV'
- include 'COMMON.CONTACTS'
- common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
- & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
- & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
- &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
- & ielend_all(maxres,0:max_fg_procs-1),
- & ntask_cont_from_all(0:max_fg_procs-1),
- & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1),
- & ntask_cont_to_all(0:max_fg_procs-1),
- & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1)
- integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP
- logical scheck,lprint,flag
-#ifdef MPI
- integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs),
- & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs)
-C... Determine the numbers of start and end SC-SC interaction
-C... to deal with by current processor.
- do i=0,nfgtasks-1
- itask_cont_from(i)=fg_rank
- itask_cont_to(i)=fg_rank
- enddo
- lprint=.false.
- if (lprint)
- &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct
- n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss
- call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde)
- if (lprint)
- & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
- & ' absolute rank',MyRank,
- & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds,
- & ' my_sc_inde',my_sc_inde
- ind_sctint=0
- iatsc_s=0
- iatsc_e=0
-#endif
-c lprint=.false.
- do i=1,maxres
- nint_gr(i)=0
- nscp_gr(i)=0
- do j=1,maxint_gr
- istart(i,1)=0
- iend(i,1)=0
- ielstart(i)=0
- ielend(i)=0
- iscpstart(i,1)=0
- iscpend(i,1)=0
- enddo
- enddo
- ind_scint=0
- ind_scint_old=0
-cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb',
-cd & (ihpb(i),jhpb(i),i=1,nss)
- do i=nnt,nct-1
- scheck=.false.
- if (dyn_ss) goto 10
- do ii=1,nss
- if (ihpb(ii).eq.i+nres) then
- scheck=.true.
- jj=jhpb(ii)-nres
- goto 10
- endif
- enddo
- 10 continue
-cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj
- if (scheck) then
- if (jj.eq.i+1) then
-#ifdef MPI
-c write (iout,*) 'jj=i+1'
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
- & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
-#else
- nint_gr(i)=1
- istart(i,1)=i+2
- iend(i,1)=nct
-#endif
- else if (jj.eq.nct) then
-#ifdef MPI
-c write (iout,*) 'jj=nct'
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
- & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12)
-#else
- nint_gr(i)=1
- istart(i,1)=i+1
- iend(i,1)=nct-1
-#endif
- else
-#ifdef MPI
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
- & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12)
- ii=nint_gr(i)+1
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
- & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12)
-#else
- nint_gr(i)=2
- istart(i,1)=i+1
- iend(i,1)=jj-1
- istart(i,2)=jj+1
- iend(i,2)=nct
-#endif
- endif
- else
-#ifdef MPI
- call int_partition(ind_scint,my_sc_inds,my_sc_inde,i,
- & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12)
-#else
- nint_gr(i)=1
- istart(i,1)=i+1
- iend(i,1)=nct
- ind_scint=ind_scint+nct-i
-#endif
- endif
-#ifdef MPI
- ind_scint_old=ind_scint
-#endif
- enddo
- 12 continue
-#ifndef MPI
- iatsc_s=nnt
- iatsc_e=nct-1
-#endif
-#ifdef MPI
- if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor,
- & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e
-#endif
- if (lprint) then
- write (iout,'(a)') 'Interaction array:'
- do i=iatsc_s,iatsc_e
- write (iout,'(i3,2(2x,2i3))')
- & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i))
- enddo
- endif
- ispp=4
-#ifdef MPI
-C Now partition the electrostatic-interaction array
- npept=nct-nnt
- nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
- call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
- if (lprint)
- & write (*,*) 'Processor',fg_rank,' CG group',kolor,
- & ' absolute rank',MyRank,
- & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds,
- & ' my_ele_inde',my_ele_inde
- iatel_s=0
- iatel_e=0
- ind_eleint=0
- ind_eleint_old=0
- do i=nnt,nct-3
- ijunk=0
- call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i,
- & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13)
- enddo ! i
- 13 continue
- if (iatel_s.eq.0) iatel_s=1
- nele_int_tot_vdw=(npept-2)*(npept-2+1)/2
-c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw
- call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw)
-c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw,
-c & " my_ele_inde_vdw",my_ele_inde_vdw
- ind_eleint_vdw=0
- ind_eleint_vdw_old=0
- iatel_s_vdw=0
- iatel_e_vdw=0
- do i=nnt,nct-3
- ijunk=0
- call int_partition(ind_eleint_vdw,my_ele_inds_vdw,
- & my_ele_inde_vdw,i,
- & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i),
- & ielend_vdw(i),*15)
-c write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
-c & " ielend_vdw",ielend_vdw(i)
- enddo ! i
- if (iatel_s_vdw.eq.0) iatel_s_vdw=1
- 15 continue
-#else
- iatel_s=nnt
- iatel_e=nct-5
- do i=iatel_s,iatel_e
- ielstart(i)=i+4
- ielend(i)=nct-1
- enddo
- iatel_s_vdw=nnt
- iatel_e_vdw=nct-3
- do i=iatel_s_vdw,iatel_e_vdw
- ielstart_vdw(i)=i+2
- ielend_vdw(i)=nct-1
- enddo
-#endif
- if (lprint) then
- write (*,'(a)') 'Processor',fg_rank,' CG group',kolor,
- & ' absolute rank',MyRank
- write (iout,*) 'Electrostatic interaction array:'
- do i=iatel_s,iatel_e
- write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i)
- enddo
- endif ! lprint
-c iscp=3
- iscp=2
-C Partition the SC-p interaction array
-#ifdef MPI
- nscp_int_tot=(npept-iscp+1)*(npept-iscp+1)
- call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde)
- if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor,
- & ' absolute rank',myrank,
- & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds,
- & ' my_scp_inde',my_scp_inde
- iatscp_s=0
- iatscp_e=0
- ind_scpint=0
- ind_scpint_old=0
- do i=nnt,nct-1
- if (i.lt.nnt+iscp) then
-cd write (iout,*) 'i.le.nnt+iscp'
- call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
- & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1),
- & iscpend(i,1),*14)
- else if (i.gt.nct-iscp) then
-cd write (iout,*) 'i.gt.nct-iscp'
- call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
- & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
- & iscpend(i,1),*14)
- else
- call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
- & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1),
- & iscpend(i,1),*14)
- ii=nscp_gr(i)+1
- call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i,
- & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii),
- & iscpend(i,ii),*14)
- endif
- enddo ! i
- 14 continue
-#else
- iatscp_s=nnt
- iatscp_e=nct-1
- do i=nnt,nct-1
- if (i.lt.nnt+iscp) then
- nscp_gr(i)=1
- iscpstart(i,1)=i+iscp
- iscpend(i,1)=nct
- elseif (i.gt.nct-iscp) then
- nscp_gr(i)=1
- iscpstart(i,1)=nnt
- iscpend(i,1)=i-iscp
- else
- nscp_gr(i)=2
- iscpstart(i,1)=nnt
- iscpend(i,1)=i-iscp
- iscpstart(i,2)=i+iscp
- iscpend(i,2)=nct
- endif
- enddo ! i
-#endif
- if (lprint) then
- write (iout,'(a)') 'SC-p interaction array:'
- do i=iatscp_s,iatscp_e
- write (iout,'(i3,2(2x,2i3))')
- & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i))
- enddo
- endif ! lprint
-C Partition local interactions
-#ifdef MPI
- call int_bounds(nres-2,loc_start,loc_end)
- loc_start=loc_start+1
- loc_end=loc_end+1
- call int_bounds(nres-2,ithet_start,ithet_end)
- ithet_start=ithet_start+2
- ithet_end=ithet_end+2
- call int_bounds(nct-nnt-2,iturn3_start,iturn3_end)
- iturn3_start=iturn3_start+nnt
- iphi_start=iturn3_start+2
- iturn3_end=iturn3_end+nnt
- iphi_end=iturn3_end+2
- iturn3_start=iturn3_start-1
- iturn3_end=iturn3_end-1
- call int_bounds(nres-3,itau_start,itau_end)
- itau_start=itau_start+3
- itau_end=itau_end+3
- call int_bounds(nres-3,iphi1_start,iphi1_end)
- iphi1_start=iphi1_start+3
- iphi1_end=iphi1_end+3
- call int_bounds(nct-nnt-3,iturn4_start,iturn4_end)
- iturn4_start=iturn4_start+nnt
- iphid_start=iturn4_start+2
- iturn4_end=iturn4_end+nnt
- iphid_end=iturn4_end+2
- iturn4_start=iturn4_start-1
- iturn4_end=iturn4_end-1
- call int_bounds(nres-2,ibond_start,ibond_end)
- ibond_start=ibond_start+1
- ibond_end=ibond_end+1
- call int_bounds(nct-nnt,ibondp_start,ibondp_end)
- ibondp_start=ibondp_start+nnt
- ibondp_end=ibondp_end+nnt
- call int_bounds1(nres-1,ivec_start,ivec_end)
- print *,"Processor",myrank,fg_rank,fg_rank1,
- & " ivec_start",ivec_start," ivec_end",ivec_end
- iset_start=loc_start+2
- iset_end=loc_end+2
- if (ndih_constr.eq.0) then
- idihconstr_start=1
- idihconstr_end=0
- else
- call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
- endif
- nsumgrad=(nres-nnt)*(nres-nnt+1)/2
- nlen=nres-nnt+1
- call int_bounds(nsumgrad,ngrad_start,ngrad_end)
- igrad_start=((2*nlen+1)
- & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2
- jgrad_start(igrad_start)=
- & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2
- & +igrad_start
- jgrad_end(igrad_start)=nres
- igrad_end=((2*nlen+1)
- & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2
- if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1
- jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2
- & +igrad_end
- do i=igrad_start+1,igrad_end-1
- jgrad_start(i)=i+1
- jgrad_end(i)=nres
- enddo
- if (lprint) then
- write (*,*) 'Processor:',fg_rank,' CG group',kolor,
- & ' absolute rank',myrank,
- & ' loc_start',loc_start,' loc_end',loc_end,
- & ' ithet_start',ithet_start,' ithet_end',ithet_end,
- & ' iphi_start',iphi_start,' iphi_end',iphi_end,
- & ' iphid_start',iphid_start,' iphid_end',iphid_end,
- & ' ibond_start',ibond_start,' ibond_end',ibond_end,
- & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end,
- & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end,
- & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end,
- & ' ivec_start',ivec_start,' ivec_end',ivec_end,
- & ' iset_start',iset_start,' iset_end',iset_end,
- & ' idihconstr_start',idihconstr_start,' idihconstr_end',
- & idihconstr_end
- write (*,*) 'Processor:',fg_rank,myrank,' igrad_start',
- & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start,
- & ' ngrad_end',ngrad_end
- do i=igrad_start,igrad_end
- write(*,*) 'Processor:',fg_rank,myrank,i,
- & jgrad_start(i),jgrad_end(i)
- enddo
- endif
- if (nfgtasks.gt.1) then
- call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1,
- & MPI_INTEGER,FG_COMM1,IERROR)
- iaux=ivec_end-ivec_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1,
- & MPI_INTEGER,FG_COMM1,IERROR)
- call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=iset_end-iset_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=ibond_end-ibond_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=ithet_end-ithet_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=iphi_end-iphi_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- iaux=iphi1_end-iphi1_start+1
- call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- do i=0,maxprocs-1
- do j=1,maxres
- ielstart_all(j,i)=0
- ielend_all(j,i)=0
- enddo
- enddo
- call MPI_Allgather(iturn3_start,1,MPI_INTEGER,
- & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iturn4_start,1,MPI_INTEGER,
- & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iturn3_end,1,MPI_INTEGER,
- & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iturn4_end,1,MPI_INTEGER,
- & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iatel_s,1,MPI_INTEGER,
- & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(iatel_e,1,MPI_INTEGER,
- & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER,
- & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(ielend(1),maxres,MPI_INTEGER,
- & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR)
- if (lprint) then
- write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks)
- write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks)
- write (iout,*) "iturn3_start_all",
- & (iturn3_start_all(i),i=0,nfgtasks-1)
- write (iout,*) "iturn3_end_all",
- & (iturn3_end_all(i),i=0,nfgtasks-1)
- write (iout,*) "iturn4_start_all",
- & (iturn4_start_all(i),i=0,nfgtasks-1)
- write (iout,*) "iturn4_end_all",
- & (iturn4_end_all(i),i=0,nfgtasks-1)
- write (iout,*) "The ielstart_all array"
- do i=nnt,nct
- write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1)
- enddo
- write (iout,*) "The ielend_all array"
- do i=nnt,nct
- write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1)
- enddo
- call flush(iout)
- endif
- ntask_cont_from=0
- ntask_cont_to=0
- itask_cont_from(0)=fg_rank
- itask_cont_to(0)=fg_rank
- flag=.false.
- do ii=iturn3_start,iturn3_end
- call add_int(ii,ii+2,iturn3_sent(1,ii),
- & ntask_cont_to,itask_cont_to,flag)
- enddo
- do ii=iturn4_start,iturn4_end
- call add_int(ii,ii+3,iturn4_sent(1,ii),
- & ntask_cont_to,itask_cont_to,flag)
- enddo
- do ii=iturn3_start,iturn3_end
- call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from)
- enddo
- do ii=iturn4_start,iturn4_end
- call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from)
- enddo
- if (lprint) then
- write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from,
- & " ntask_cont_to",ntask_cont_to
- write (iout,*) "itask_cont_from",
- & (itask_cont_from(i),i=1,ntask_cont_from)
- write (iout,*) "itask_cont_to",
- & (itask_cont_to(i),i=1,ntask_cont_to)
- call flush(iout)
- endif
-c write (iout,*) "Loop forward"
-c call flush(iout)
- do i=iatel_s,iatel_e
-c write (iout,*) "from loop i=",i
-c call flush(iout)
- do j=ielstart(i),ielend(i)
- call add_int_from(i,j,ntask_cont_from,itask_cont_from)
- enddo
- enddo
-c write (iout,*) "Loop backward iatel_e-1",iatel_e-1,
-c & " iatel_e",iatel_e
-c call flush(iout)
- nat_sent=0
- do i=iatel_s,iatel_e
-c write (iout,*) "i",i," ielstart",ielstart(i),
-c & " ielend",ielend(i)
-c call flush(iout)
- flag=.false.
- do j=ielstart(i),ielend(i)
- call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to,
- & itask_cont_to,flag)
- enddo
- if (flag) then
- nat_sent=nat_sent+1
- iat_sent(nat_sent)=i
- endif
- enddo
- if (lprint) then
- write (iout,*)"After longrange ntask_cont_from",ntask_cont_from,
- & " ntask_cont_to",ntask_cont_to
- write (iout,*) "itask_cont_from",
- & (itask_cont_from(i),i=1,ntask_cont_from)
- write (iout,*) "itask_cont_to",
- & (itask_cont_to(i),i=1,ntask_cont_to)
- call flush(iout)
- write (iout,*) "iint_sent"
- do i=1,nat_sent
- ii=iat_sent(i)
- write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4),
- & j=ielstart(ii),ielend(ii))
- enddo
- write (iout,*) "iturn3_sent iturn3_start",iturn3_start,
- & " iturn3_end",iturn3_end
- write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4),
- & i=iturn3_start,iturn3_end)
- write (iout,*) "iturn4_sent iturn4_start",iturn4_start,
- & " iturn4_end",iturn4_end
- write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4),
- & i=iturn4_start,iturn4_end)
- call flush(iout)
- endif
- call MPI_Gather(ntask_cont_from,1,MPI_INTEGER,
- & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR)
-c write (iout,*) "Gather ntask_cont_from ended"
-c call flush(iout)
- call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER,
- & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king,
- & FG_COMM,IERR)
-c write (iout,*) "Gather itask_cont_from ended"
-c call flush(iout)
- call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all,
- & 1,MPI_INTEGER,king,FG_COMM,IERR)
-c write (iout,*) "Gather ntask_cont_to ended"
-c call flush(iout)
- call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER,
- & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR)
-c write (iout,*) "Gather itask_cont_to ended"
-c call flush(iout)
- if (fg_rank.eq.king) then
- write (iout,*)"Contact receive task map (proc, #tasks, tasks)"
- do i=0,nfgtasks-1
- write (iout,'(20i4)') i,ntask_cont_from_all(i),
- & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i))
- enddo
- write (iout,*)
- call flush(iout)
- write (iout,*) "Contact send task map (proc, #tasks, tasks)"
- do i=0,nfgtasks-1
- write (iout,'(20i4)') i,ntask_cont_to_all(i),
- & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i))
- enddo
- write (iout,*)
- call flush(iout)
-C Check if every send will have a matching receive
- ncheck_to=0
- ncheck_from=0
- do i=0,nfgtasks-1
- ncheck_to=ncheck_to+ntask_cont_to_all(i)
- ncheck_from=ncheck_from+ntask_cont_from_all(i)
- enddo
- write (iout,*) "Control sums",ncheck_from,ncheck_to
- if (ncheck_from.ne.ncheck_to) then
- write (iout,*) "Error: #receive differs from #send."
- write (iout,*) "Terminating program...!"
- call flush(iout)
- flag=.false.
- else
- flag=.true.
- do i=0,nfgtasks-1
- do j=1,ntask_cont_to_all(i)
- ii=itask_cont_to_all(j,i)
- do k=1,ntask_cont_from_all(ii)
- if (itask_cont_from_all(k,ii).eq.i) then
- if(lprint)write(iout,*)"Matching send/receive",i,ii
- exit
- endif
- enddo
- if (k.eq.ntask_cont_from_all(ii)+1) then
- flag=.false.
- write (iout,*) "Error: send by",j," to",ii,
- & " would have no matching receive"
- endif
- enddo
- enddo
- endif
- if (.not.flag) then
- write (iout,*) "Unmatched sends; terminating program"
- call flush(iout)
- endif
- endif
- call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR)
-c write (iout,*) "flag broadcast ended flag=",flag
-c call flush(iout)
- if (.not.flag) then
- call MPI_Finalize(IERROR)
- stop "Error in INIT_INT_TABLE: unmatched send/receive."
- endif
- call MPI_Comm_group(FG_COMM,fg_group,IERR)
-c write (iout,*) "MPI_Comm_group ended"
-c call flush(iout)
- call MPI_Group_incl(fg_group,ntask_cont_from+1,
- & itask_cont_from(0),CONT_FROM_GROUP,IERR)
- call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0),
- & CONT_TO_GROUP,IERR)
- do i=1,nat_sent
- ii=iat_sent(i)
- iaux=4*(ielend(ii)-ielstart(ii)+1)
- call MPI_Group_translate_ranks(fg_group,iaux,
- & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP,
- & iint_sent_local(1,ielstart(ii),i),IERR )
-c write (iout,*) "Ranks translated i=",i
-c call flush(iout)
- enddo
- iaux=4*(iturn3_end-iturn3_start+1)
- call MPI_Group_translate_ranks(fg_group,iaux,
- & iturn3_sent(1,iturn3_start),CONT_TO_GROUP,
- & iturn3_sent_local(1,iturn3_start),IERR)
- iaux=4*(iturn4_end-iturn4_start+1)
- call MPI_Group_translate_ranks(fg_group,iaux,
- & iturn4_sent(1,iturn4_start),CONT_TO_GROUP,
- & iturn4_sent_local(1,iturn4_start),IERR)
- if (lprint) then
- write (iout,*) "iint_sent_local"
- do i=1,nat_sent
- ii=iat_sent(i)
- write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4),
- & j=ielstart(ii),ielend(ii))
- call flush(iout)
- enddo
- write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start,
- & " iturn3_end",iturn3_end
- write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4),
- & i=iturn3_start,iturn3_end)
- write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start,
- & " iturn4_end",iturn4_end
- write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4),
- & i=iturn4_start,iturn4_end)
- call flush(iout)
- endif
- call MPI_Group_free(fg_group,ierr)
- call MPI_Group_free(cont_from_group,ierr)
- call MPI_Group_free(cont_to_group,ierr)
- call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR)
- call MPI_Type_commit(MPI_UYZ,IERROR)
- call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD,
- & IERROR)
- call MPI_Type_commit(MPI_UYZGRAD,IERROR)
- call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR)
- call MPI_Type_commit(MPI_MU,IERROR)
- call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR)
- call MPI_Type_commit(MPI_MAT1,IERROR)
- call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR)
- call MPI_Type_commit(MPI_MAT2,IERROR)
- call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR)
- call MPI_Type_commit(MPI_THET,IERROR)
- call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR)
- call MPI_Type_commit(MPI_GAM,IERROR)
-#ifndef MATGATHER
-c 9/22/08 Derived types to send matrices which appear in correlation terms
- do i=0,nfgtasks-1
- if (ivec_count(i).eq.ivec_count(0)) then
- lentyp(i)=0
- else
- lentyp(i)=1
- endif
- enddo
- do ind_typ=lentyp(0),lentyp(nfgtasks-1)
- if (ind_typ.eq.0) then
- ichunk=ivec_count(0)
- else
- ichunk=ivec_count(1)
- endif
-c do i=1,4
-c blocklengths(i)=4
-c enddo
-c displs(1)=0
-c do i=2,4
-c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
-c enddo
-c do i=1,4
-c blocklengths(i)=blocklengths(i)*ichunk
-c enddo
-c write (iout,*) "blocklengths and displs"
-c do i=1,4
-c write (iout,*) i,blocklengths(i),displs(i)
-c enddo
-c call flush(iout)
-c call MPI_Type_indexed(4,blocklengths(1),displs(1),
-c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR)
-c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR)
-c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1
-c do i=1,4
-c blocklengths(i)=2
-c enddo
-c displs(1)=0
-c do i=2,4
-c displs(i)=displs(i-1)+blocklengths(i-1)*maxres
-c enddo
-c do i=1,4
-c blocklengths(i)=blocklengths(i)*ichunk
-c enddo
-c write (iout,*) "blocklengths and displs"
-c do i=1,4
-c write (iout,*) i,blocklengths(i),displs(i)
-c enddo
-c call flush(iout)
-c call MPI_Type_indexed(4,blocklengths(1),displs(1),
-c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR)
-c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR)
-c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2
- do i=1,8
- blocklengths(i)=2
- enddo
- displs(1)=0
- do i=2,8
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,15
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(8,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR)
- call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR)
- do i=1,8
- blocklengths(i)=4
- enddo
- displs(1)=0
- do i=2,8
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,15
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(8,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR)
- call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR)
- do i=1,6
- blocklengths(i)=4
- enddo
- displs(1)=0
- do i=2,6
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,6
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(6,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR)
- call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR)
- do i=1,2
- blocklengths(i)=8
- enddo
- displs(1)=0
- do i=2,2
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,2
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(2,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR)
- call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR)
- do i=1,4
- blocklengths(i)=1
- enddo
- displs(1)=0
- do i=2,4
- displs(i)=displs(i-1)+blocklengths(i-1)*maxres
- enddo
- do i=1,4
- blocklengths(i)=blocklengths(i)*ichunk
- enddo
- call MPI_Type_indexed(4,blocklengths,displs,
- & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR)
- call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR)
- enddo
-#endif
- endif
- iint_start=ivec_start+1
- iint_end=ivec_end+1
- do i=0,nfgtasks-1
- iint_count(i)=ivec_count(i)
- iint_displ(i)=ivec_displ(i)
- ivec_displ(i)=ivec_displ(i)-1
- iset_displ(i)=iset_displ(i)-1
- ithet_displ(i)=ithet_displ(i)-1
- iphi_displ(i)=iphi_displ(i)-1
- iphi1_displ(i)=iphi1_displ(i)-1
- ibond_displ(i)=ibond_displ(i)-1
- enddo
- if (nfgtasks.gt.1 .and. fg_rank.eq.king
- & .and. (me.eq.0 .or. out1file)) then
- write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT"
- do i=0,nfgtasks-1
- write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i),
- & iset_count(i)
- enddo
- write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end,
- & " iphi1_start",iphi1_start," iphi1_end",iphi1_end
- write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL"
- do i=0,nfgtasks-1
- write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i),
- & iphi1_displ(i)
- enddo
- write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ',
- & nele_int_tot,' electrostatic and ',nscp_int_tot,
- & ' SC-p interactions','were distributed among',nfgtasks,
- & ' fine-grain processors.'
- endif
-#else
- loc_start=2
- loc_end=nres-1
- ithet_start=3
- ithet_end=nres
- iturn3_start=nnt
- iturn3_end=nct-3
- iturn4_start=nnt
- iturn4_end=nct-4
- iphi_start=nnt+3
- iphi_end=nct
- iphi1_start=4
- iphi1_end=nres
- idihconstr_start=1
- idihconstr_end=ndih_constr
- iphid_start=iphi_start
- iphid_end=iphi_end-1
- itau_start=4
- itau_end=nres
- ibond_start=2
- ibond_end=nres-1
- ibondp_start=nnt+1
- ibondp_end=nct
- ivec_start=1
- ivec_end=nres-1
- iset_start=3
- iset_end=nres+1
- iint_start=2
- iint_end=nres-1
-#endif
- return
- end
-#ifdef MPI
-c---------------------------------------------------------------------------
- subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag)
- implicit none
- include "DIMENSIONS"
- include "COMMON.INTERACT"
- include "COMMON.SETUP"
- include "COMMON.IOUNITS"
- integer ii,jj,itask(4),
- & ntask_cont_to,itask_cont_to(0:max_fg_procs-1)
- logical flag
- integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
- & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
- common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
- & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
- & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
- &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
- & ielend_all(maxres,0:max_fg_procs-1)
- integer iproc,isent,k,l
-c Determines whether to send interaction ii,jj to other processors; a given
-c interaction can be sent to at most 2 processors.
-c Sets flag=.true. if interaction ii,jj needs to be sent to at least
-c one processor, otherwise flag is unchanged from the input value.
- isent=0
- itask(1)=fg_rank
- itask(2)=fg_rank
- itask(3)=fg_rank
- itask(4)=fg_rank
-c write (iout,*) "ii",ii," jj",jj
-c Loop over processors to check if anybody could need interaction ii,jj
- do iproc=0,fg_rank-1
-c Check if the interaction matches any turn3 at iproc
- do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
- l=k+2
- if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
- & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
- & then
-c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l
-c call flush(iout)
- flag=.true.
- if (iproc.ne.itask(1).and.iproc.ne.itask(2)
- & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
- isent=isent+1
- itask(isent)=iproc
- call add_task(iproc,ntask_cont_to,itask_cont_to)
- endif
- endif
- enddo
-C Check if the interaction matches any turn4 at iproc
- do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
- l=k+3
- if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1
- & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1)
- & then
-c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l
-c call flush(iout)
- flag=.true.
- if (iproc.ne.itask(1).and.iproc.ne.itask(2)
- & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
- isent=isent+1
- itask(isent)=iproc
- call add_task(iproc,ntask_cont_to,itask_cont_to)
- endif
- endif
- enddo
- if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and.
- & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then
- if (ielstart_all(ii-1,iproc).le.jj-1.and.
- & ielend_all(ii-1,iproc).ge.jj-1) then
- flag=.true.
- if (iproc.ne.itask(1).and.iproc.ne.itask(2)
- & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
- isent=isent+1
- itask(isent)=iproc
- call add_task(iproc,ntask_cont_to,itask_cont_to)
- endif
- endif
- if (ielstart_all(ii-1,iproc).le.jj+1.and.
- & ielend_all(ii-1,iproc).ge.jj+1) then
- flag=.true.
- if (iproc.ne.itask(1).and.iproc.ne.itask(2)
- & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then
- isent=isent+1
- itask(isent)=iproc
- call add_task(iproc,ntask_cont_to,itask_cont_to)
- endif
- endif
- endif
- enddo
- return
- end
-c---------------------------------------------------------------------------
- subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from)
- implicit none
- include "DIMENSIONS"
- include "COMMON.INTERACT"
- include "COMMON.SETUP"
- include "COMMON.IOUNITS"
- integer ii,jj,itask(2),ntask_cont_from,
- & itask_cont_from(0:max_fg_procs-1)
- logical flag
- integer iturn3_start_all,iturn3_end_all,iturn4_start_all,
- & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all
- common /przechowalnia/ iturn3_start_all(0:max_fg_procs),
- & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs),
- & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs),
- &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1),
- & ielend_all(maxres,0:max_fg_procs-1)
- integer iproc,k,l
- do iproc=fg_rank+1,nfgtasks-1
- do k=iturn3_start_all(iproc),iturn3_end_all(iproc)
- l=k+2
- if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
- & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
- & then
-c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- enddo
- do k=iturn4_start_all(iproc),iturn4_end_all(iproc)
- l=k+3
- if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1
- & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1)
- & then
-c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- enddo
- if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then
- if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc))
- & then
- if (jj+1.ge.ielstart_all(ii+1,iproc).and.
- & jj+1.le.ielend_all(ii+1,iproc)) then
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- if (jj-1.ge.ielstart_all(ii+1,iproc).and.
- & jj-1.le.ielend_all(ii+1,iproc)) then
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- endif
- if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc))
- & then
- if (jj-1.ge.ielstart_all(ii-1,iproc).and.
- & jj-1.le.ielend_all(ii-1,iproc)) then
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- if (jj+1.ge.ielstart_all(ii-1,iproc).and.
- & jj+1.le.ielend_all(ii-1,iproc)) then
- call add_task(iproc,ntask_cont_from,itask_cont_from)
- endif
- endif
- endif
- enddo
- return
- end
-c---------------------------------------------------------------------------
- subroutine add_task(iproc,ntask_cont,itask_cont)
- implicit none
- include "DIMENSIONS"
- integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1)
- integer ii
- do ii=1,ntask_cont
- if (itask_cont(ii).eq.iproc) return
- enddo
- ntask_cont=ntask_cont+1
- itask_cont(ntask_cont)=iproc
- return
- end
-c---------------------------------------------------------------------------
- subroutine int_bounds(total_ints,lower_bound,upper_bound)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- integer total_ints,lower_bound,upper_bound
- integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
- nint=total_ints/nfgtasks
- do i=1,nfgtasks
- int4proc(i-1)=nint
- enddo
- nexcess=total_ints-nint*nfgtasks
- do i=1,nexcess
- int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1
- enddo
- lower_bound=0
- do i=0,fg_rank-1
- lower_bound=lower_bound+int4proc(i)
- enddo
- upper_bound=lower_bound+int4proc(fg_rank)
- lower_bound=lower_bound+1
- return
- end
-c---------------------------------------------------------------------------
- subroutine int_bounds1(total_ints,lower_bound,upper_bound)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.SETUP'
- integer total_ints,lower_bound,upper_bound
- integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs)
- nint=total_ints/nfgtasks1
- do i=1,nfgtasks1
- int4proc(i-1)=nint
- enddo
- nexcess=total_ints-nint*nfgtasks1
- do i=1,nexcess
- int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1
- enddo
- lower_bound=0
- do i=0,fg_rank1-1
- lower_bound=lower_bound+int4proc(i)
- enddo
- upper_bound=lower_bound+int4proc(fg_rank1)
- lower_bound=lower_bound+1
- return
- end
-c---------------------------------------------------------------------------
- subroutine int_partition(int_index,lower_index,upper_index,atom,
- & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- integer int_index,lower_index,upper_index,atom,at_start,at_end,
- & first_atom,last_atom,int_gr,jat_start,jat_end
- logical lprn
- lprn=.false.
- if (lprn) write (iout,*) 'int_index=',int_index
- int_index_old=int_index
- int_index=int_index+last_atom-first_atom+1
- if (lprn)
- & write (iout,*) 'int_index=',int_index,
- & ' int_index_old',int_index_old,
- & ' lower_index=',lower_index,
- & ' upper_index=',upper_index,
- & ' atom=',atom,' first_atom=',first_atom,
- & ' last_atom=',last_atom
- if (int_index.ge.lower_index) then
- int_gr=int_gr+1
- if (at_start.eq.0) then
- at_start=atom
- jat_start=first_atom-1+lower_index-int_index_old
- else
- jat_start=first_atom
- endif
- if (lprn) write (iout,*) 'jat_start',jat_start
- if (int_index.ge.upper_index) then
- at_end=atom
- jat_end=first_atom-1+upper_index-int_index_old
- return1
- else
- jat_end=last_atom
- endif
- if (lprn) write (iout,*) 'jat_end',jat_end
- endif
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine hpb_partition
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SBRIDGE'
- include 'COMMON.IOUNITS'
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
-c write(2,*)"hpb_partition: nhpb=",nhpb
-#ifdef MPI
- call int_bounds(nhpb,link_start,link_end)
- if (.not. out1file)
- & write (iout,*) 'Processor',fg_rank,' CG group',kolor,
- & ' absolute rank',MyRank,
- & ' nhpb',nhpb,' link_start=',link_start,
- & ' link_end',link_end
-#else
- link_start=1
- link_end=nhpb
-#endif
-c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end
- return
- end
+++ /dev/null
- subroutine int_to_cart
-c--------------------------------------------------------------
-c This subroutine converts the energy derivatives from internal
-c coordinates to cartesian coordinates
-c-------------------------------------------------------------
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- include 'COMMON.SCCOR'
-c calculating dE/ddc1
- if (nres.lt.3) goto 18
-c do i=1,nres
-c c do intertyp=1,3
-c write (iout,*) "przed tosyjnymi",i,intertyp,gcart(intertyp,i)
-c &,gloc_sc(1,i,icg),gloc(i,icg)
-c enddo
-c enddo
- do j=1,3
- gcart(j,1)=gcart(j,1)+gloc(1,icg)*dphi(j,1,4)
- & +gloc(nres-2,icg)*dtheta(j,1,3)
- if(itype(2).ne.10) then
- gcart(j,1)=gcart(j,1)+gloc(ialph(2,1),icg)*dalpha(j,1,2)+
- & gloc(ialph(2,1)+nside,icg)*domega(j,1,2)
- endif
- enddo
-c Calculating the remainder of dE/ddc2
- do j=1,3
- gcart(j,2)=gcart(j,2)+gloc(1,icg)*dphi(j,2,4)+
- & gloc(nres-2,icg)*dtheta(j,2,3)+gloc(nres-1,icg)*dtheta(j,1,4)
- if(itype(2).ne.10) then
- gcart(j,2)=gcart(j,2)+gloc(ialph(2,1),icg)*dalpha(j,2,2)+
- & gloc(ialph(2,1)+nside,icg)*domega(j,2,2)
- endif
- if(itype(3).ne.10) then
- gcart(j,2)=gcart(j,2)+gloc(ialph(3,1),icg)*dalpha(j,1,3)+
- & gloc(ialph(3,1)+nside,icg)*domega(j,1,3)
- endif
- if(nres.gt.4) then
- gcart(j,2)=gcart(j,2)+gloc(2,icg)*dphi(j,1,5)
- endif
- enddo
-c If there are only five residues
- if(nres.eq.5) then
- do j=1,3
- gcart(j,3)=gcart(j,3)+gloc(1,icg)*dphi(j,3,4)+gloc(2,icg)*
- & dphi(j,2,5)+gloc(nres-1,icg)*dtheta(j,2,4)+gloc(nres,icg)*
- & dtheta(j,1,5)
- if(itype(3).ne.10) then
- gcart(j,3)=gcart(j,3)+gloc(ialph(3,1),icg)*
- & dalpha(j,2,3)+gloc(ialph(3,1)+nside,icg)*domega(j,2,3)
- endif
- if(itype(4).ne.10) then
- gcart(j,3)=gcart(j,3)+gloc(ialph(4,1),icg)*
- & dalpha(j,1,4)+gloc(ialph(4,1)+nside,icg)*domega(j,1,4)
- endif
- enddo
- endif
-c If there are more than five residues
- if(nres.gt.5) then
- do i=3,nres-3
- do j=1,3
- gcart(j,i)=gcart(j,i)+gloc(i-2,icg)*dphi(j,3,i+1)
- & +gloc(i-1,icg)*dphi(j,2,i+2)+
- & gloc(i,icg)*dphi(j,1,i+3)+gloc(nres+i-4,icg)*dtheta(j,2,i+1)+
- & gloc(nres+i-3,icg)*dtheta(j,1,i+2)
- if(itype(i).ne.10) then
- gcart(j,i)=gcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,2,i)+
- & gloc(ialph(i,1)+nside,icg)*domega(j,2,i)
- endif
- if(itype(i+1).ne.10) then
- gcart(j,i)=gcart(j,i)+gloc(ialph(i+1,1),icg)*dalpha(j,1,i+1)
- & +gloc(ialph(i+1,1)+nside,icg)*domega(j,1,i+1)
- endif
- enddo
- enddo
- endif
-c Setting dE/ddnres-2
- if(nres.gt.5) then
- do j=1,3
- gcart(j,nres-2)=gcart(j,nres-2)+gloc(nres-4,icg)*
- & dphi(j,3,nres-1)+gloc(nres-3,icg)*dphi(j,2,nres)
- & +gloc(2*nres-6,icg)*
- & dtheta(j,2,nres-1)+gloc(2*nres-5,icg)*dtheta(j,1,nres)
- if(itype(nres-2).ne.10) then
- gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-2,1),icg)*
- & dalpha(j,2,nres-2)+gloc(ialph(nres-2,1)+nside,icg)*
- & domega(j,2,nres-2)
- endif
- if(itype(nres-1).ne.10) then
- gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-1,1),icg)*
- & dalpha(j,1,nres-1)+gloc(ialph(nres-1,1)+nside,icg)*
- & domega(j,1,nres-1)
- endif
- enddo
- endif
-c Settind dE/ddnres-1
- do j=1,3
- gcart(j,nres-1)=gcart(j,nres-1)+gloc(nres-3,icg)*dphi(j,3,nres)+
- & gloc(2*nres-5,icg)*dtheta(j,2,nres)
- if(itype(nres-1).ne.10) then
- gcart(j,nres-1)=gcart(j,nres-1)+gloc(ialph(nres-1,1),icg)*
- & dalpha(j,2,nres-1)+gloc(ialph(nres-1,1)+nside,icg)*
- & domega(j,2,nres-1)
- endif
- enddo
-c The side-chain vector derivatives
- do i=2,nres-1
- if(itype(i).ne.10) then
- do j=1,3
- gxcart(j,i)=gxcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,3,i)
- & +gloc(ialph(i,1)+nside,icg)*domega(j,3,i)
- enddo
- endif
- enddo
-c----------------------------------------------------------------------
-C INTERTYP=1 SC...Ca...Ca...Ca
-C INTERTYP=2 Ca...Ca...Ca...SC
-C INTERTYP=3 SC...Ca...Ca...SC
-c calculating dE/ddc1
- 18 continue
-c do i=1,nres
-c gloc(i,icg)=0.0D0
-c write (iout,*) "poczotkoawy",i,gloc_sc(1,i,icg)
-c enddo
- if (nres.lt.2) return
- if ((nres.lt.3).and.(itype(1).eq.10)) return
- if ((itype(1).ne.10).and.(itype(1).ne.21)) then
- do j=1,3
-cc Derviative was calculated for oposite vector of side chain therefore
-c there is "-" sign before gloc_sc
- gxcart(j,1)=gxcart(j,1)-gloc_sc(1,0,icg)*
- & dtauangle(j,1,1,3)
- gcart(j,1)=gcart(j,1)+gloc_sc(1,0,icg)*
- & dtauangle(j,1,2,3)
- if ((itype(2).ne.10).and.(itype(2).ne.21)) then
- gxcart(j,1)= gxcart(j,1)
- & -gloc_sc(3,0,icg)*dtauangle(j,3,1,3)
- gcart(j,1)=gcart(j,1)+gloc_sc(3,0,icg)*
- & dtauangle(j,3,2,3)
- endif
- enddo
- endif
- if ((nres.ge.3).and.(itype(3).ne.10).and.(itype(3).ne.21))
- & then
- do j=1,3
- gcart(j,1)=gcart(j,1)+gloc_sc(2,1,icg)*dtauangle(j,2,1,4)
- enddo
- endif
-c As potetnial DO NOT depend on omicron anlge their derivative is
-c ommited
-c & +gloc_sc(intertyp,nres-2,icg)*dtheta(j,1,3)
-
-c Calculating the remainder of dE/ddc2
- do j=1,3
- if((itype(2).ne.10).and.(itype(2).ne.21)) then
- if (itype(1).ne.10) gxcart(j,2)=gxcart(j,2)+
- & gloc_sc(3,0,icg)*dtauangle(j,3,3,3)
- if ((itype(3).ne.10).and.(nres.ge.3).and.(itype(3).ne.21)) then
- gxcart(j,2)=gxcart(j,2)-gloc_sc(3,1,icg)*dtauangle(j,3,1,4)
-cc the - above is due to different vector direction
- gcart(j,2)=gcart(j,2)+gloc_sc(3,1,icg)*dtauangle(j,3,2,4)
- endif
- if (nres.gt.3) then
- gxcart(j,2)=gxcart(j,2)-gloc_sc(1,1,icg)*dtauangle(j,1,1,4)
-cc the - above is due to different vector direction
- gcart(j,2)=gcart(j,2)+gloc_sc(1,1,icg)*dtauangle(j,1,2,4)
-c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,2,4),"gcart"
-c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,1,4),"gx"
- endif
- endif
- if ((itype(1).ne.10).and.(itype(1).ne.21)) then
- gcart(j,2)=gcart(j,2)+gloc_sc(1,0,icg)*dtauangle(j,1,3,3)
-c write(iout,*) gloc_sc(1,0,icg),dtauangle(j,1,3,3)
- endif
- if ((itype(3).ne.10).and.(nres.ge.3)) then
- gcart(j,2)=gcart(j,2)+gloc_sc(2,1,icg)*dtauangle(j,2,2,4)
-c write(iout,*) gloc_sc(2,1,icg),dtauangle(j,2,2,4)
- endif
- if ((itype(4).ne.10).and.(nres.ge.4)) then
- gcart(j,2)=gcart(j,2)+gloc_sc(2,2,icg)*dtauangle(j,2,1,5)
-c write(iout,*) gloc_sc(2,2,icg),dtauangle(j,2,1,5)
- endif
-
-c write(iout,*) gcart(j,2),itype(2),itype(1),itype(3), "gcart2"
- enddo
-c If there are more than five residues
- if(nres.ge.5) then
- do i=3,nres-2
- do j=1,3
-c write(iout,*) "before", gcart(j,i)
- if (itype(i).ne.10) then
- gxcart(j,i)=gxcart(j,i)+gloc_sc(2,i-2,icg)
- & *dtauangle(j,2,3,i+1)
- & -gloc_sc(1,i-1,icg)*dtauangle(j,1,1,i+2)
- gcart(j,i)=gcart(j,i)+gloc_sc(1,i-1,icg)
- & *dtauangle(j,1,2,i+2)
-c write(iout,*) "new",j,i,
-c & gcart(j,i),gloc_sc(1,i-1,icg),dtauangle(j,1,2,i+2)
-
- if (itype(i-1).ne.10) then
- gxcart(j,i)=gxcart(j,i)+gloc_sc(3,i-2,icg)
- &*dtauangle(j,3,3,i+1)
- endif
- if (itype(i+1).ne.10) then
- gxcart(j,i)=gxcart(j,i)-gloc_sc(3,i-1,icg)
- &*dtauangle(j,3,1,i+2)
- gcart(j,i)=gcart(j,i)+gloc_sc(3,i-1,icg)
- &*dtauangle(j,3,2,i+2)
- endif
- endif
- if (itype(i-1).ne.10) then
- gcart(j,i)=gcart(j,i)+gloc_sc(1,i-2,icg)*
- & dtauangle(j,1,3,i+1)
- endif
- if (itype(i+1).ne.10) then
- gcart(j,i)=gcart(j,i)+gloc_sc(2,i-1,icg)*
- & dtauangle(j,2,2,i+2)
-c write(iout,*) "numer",i,gloc_sc(2,i-1,icg),
-c & dtauangle(j,2,2,i+2)
- endif
- if (itype(i+2).ne.10) then
- gcart(j,i)=gcart(j,i)+gloc_sc(2,i,icg)*
- & dtauangle(j,2,1,i+3)
- endif
- enddo
- enddo
- endif
-c Setting dE/ddnres-1
- if(nres.ge.4) then
- do j=1,3
- if ((itype(nres-1).ne.10).and.(itype(nres-1).ne.21)) then
- gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(2,nres-3,icg)
- & *dtauangle(j,2,3,nres)
-c write (iout,*) "gxcart(nres-1)", gloc_sc(2,nres-3,icg),
-c & dtauangle(j,2,3,nres), gxcart(j,nres-1)
- if (itype(nres-2).ne.10) then
- gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(3,nres-3,icg)
- & *dtauangle(j,3,3,nres)
- endif
- if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then
- gxcart(j,nres-1)=gxcart(j,nres-1)-gloc_sc(3,nres-2,icg)
- & *dtauangle(j,3,1,nres+1)
- gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(3,nres-2,icg)
- & *dtauangle(j,3,2,nres+1)
- endif
- endif
- if ((itype(nres-2).ne.10).and.(itype(nres-2).ne.21)) then
- gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(1,nres-3,icg)*
- & dtauangle(j,1,3,nres)
- endif
- if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then
- gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(2,nres-2,icg)*
- & dtauangle(j,2,2,nres+1)
-c write (iout,*) "gcart(nres-1)", gloc_sc(2,nres-2,icg),
-c & dtauangle(j,2,2,nres+1), itype(nres-1),itype(nres)
- endif
- enddo
- endif
-c Settind dE/ddnres
- if ((nres.ge.3).and.(itype(nres).ne.10))then
- do j=1,3
- gxcart(j,nres)=gxcart(j,nres)+gloc_sc(3,nres-2,icg)
- & *dtauangle(j,3,3,nres+1)+gloc_sc(2,nres-2,icg)
- & *dtauangle(j,2,3,nres+1)
- enddo
- endif
-c The side-chain vector derivatives
- return
- end
-
-
+++ /dev/null
- subroutine intcartderiv
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.LOCAL'
- include 'COMMON.SCCOR'
- double precision dcostheta(3,2,maxres),
- & dcosphi(3,3,maxres),dsinphi(3,3,maxres),
- & dcosalpha(3,3,maxres),dcosomega(3,3,maxres),
- & dsinomega(3,3,maxres),vo1(3),vo2(3),vo3(3),
- & dummy(3),vp1(3),vp2(3),vp3(3),vpp1(3),n(3)
-
-#if defined(MPI) && defined(PARINTDER)
- if (nfgtasks.gt.1 .and. me.eq.king)
- & call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
- pi4 = 0.5d0*pipol
- pi34 = 3*pi4
-
-c write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
-c Derivatives of theta's
-#if defined(MPI) && defined(PARINTDER)
-c We need dtheta(:,:,i-1) to compute dphi(:,:,i)
- do i=max0(ithet_start-1,3),ithet_end
-#else
- do i=3,nres
-#endif
- cost=dcos(theta(i))
- sint=sqrt(1-cost*cost)
- do j=1,3
- dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/
- & vbld(i-1)
- dtheta(j,1,i)=-1/sint*dcostheta(j,1,i)
- dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/
- & vbld(i)
- dtheta(j,2,i)=-1/sint*dcostheta(j,2,i)
- enddo
- enddo
-
-#if defined(MPI) && defined(PARINTDER)
-c We need dtheta(:,:,i-1) to compute dphi(:,:,i)
- do i=max0(ithet_start-1,3),ithet_end
-#else
- do i=3,nres
-#endif
- if ((itype(i-1).ne.10).and.(itype(i-1).ne.21)) then
- cost1=dcos(omicron(1,i))
- sint1=sqrt(1-cost1*cost1)
- cost2=dcos(omicron(2,i))
- sint2=sqrt(1-cost2*cost2)
- do j=1,3
-CC Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
- dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+
- & cost1*dc_norm(j,i-2))/
- & vbld(i-1)
- domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
- dcosomicron(j,1,2,i)=-(dc_norm(j,i-2)
- & +cost1*(dc_norm(j,i-1+nres)))/
- & vbld(i-1+nres)
- domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
-CC Calculate derivative over second omicron Sci-1,Cai-1 Cai
-CC Looks messy but better than if in loop
- dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres)
- & +cost2*dc_norm(j,i-1))/
- & vbld(i)
- domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
- dcosomicron(j,2,2,i)=-(dc_norm(j,i-1)
- & +cost2*(-dc_norm(j,i-1+nres)))/
- & vbld(i-1+nres)
-c write(iout,*) "vbld", i,itype(i),vbld(i-1+nres)
- domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
- enddo
- endif
- enddo
-
-
-
-c Derivatives of phi:
-c If phi is 0 or 180 degrees, then the formulas
-c have to be derived by power series expansion of the
-c conventional formulas around 0 and 180.
-#ifdef PARINTDER
- do i=iphi1_start,iphi1_end
-#else
- do i=4,nres
-#endif
-c the conventional case
- sint=dsin(theta(i))
- sint1=dsin(theta(i-1))
- sing=dsin(phi(i))
- cost=dcos(theta(i))
- cost1=dcos(theta(i-1))
- cosg=dcos(phi(i))
- scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
-c Obtaining the gamma derivatives from sine derivative
- if (phi(i).gt.-pi4.and.phi(i).le.pi4.or.
- & phi(i).gt.pi34.and.phi(i).le.pi.or.
- & phi(i).gt.-pi.and.phi(i).le.-pi34) then
- call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1)
- & -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
- dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
- dsinphi(j,2,i)=
- & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i))
- & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
-c Bug fixed 3/24/05 (AL)
- dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i)
- & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
-c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
- enddo
-c Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3*
- & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp*
- & dc_norm(j,i-3))/vbld(i-2)
- dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
- dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2*
- & dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4*
- & dcostheta(j,1,i)
- dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
- dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4*
- & dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp*
- & dc_norm(j,i-1))/vbld(i)
- dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
- enddo
- endif
- enddo
-
-Calculate derivative of Tauangle
-#ifdef PARINTDER
- do i=itau_start,itau_end
-#else
- do i=3,nres
-#endif
- if ((itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle
-cc dtauangle(j,intertyp,dervityp,residue number)
-cc INTERTYP=1 SC...Ca...Ca..Ca
-c the conventional case
- sint=dsin(theta(i))
- sint1=dsin(omicron(2,i-1))
- sing=dsin(tauangle(1,i))
- cost=dcos(theta(i))
- cost1=dcos(omicron(2,i-1))
- cosg=dcos(tauangle(1,i))
- do j=1,3
- dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
-cc write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
- enddo
- scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
-cc write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
-c Obtaining the gamma derivatives from sine derivative
- if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or.
- & tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or.
- & tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
- call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1)
- &-(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres)))
- & *vbld_inv(i-2+nres)
- dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
- dsintau(j,1,2,i)=
- & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i))
- & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
-c write(iout,*) "dsintau", dsintau(j,1,2,i)
- dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
-c Bug fixed 3/24/05 (AL)
- dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i)
- & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
-c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
- enddo
-c Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3*
- & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp*
- & (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
- dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
- dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2*
- & dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4*
- & dcostheta(j,1,i)
- dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
- dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4*
- & dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp*
- & dc_norm(j,i-1))/vbld(i)
- dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
-c write (iout,*) "else",i
- enddo
- endif
-c do k=1,3
-c write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
-c enddo
- enddo
-CC Second case Ca...Ca...Ca...SC
-#ifdef PARINTDER
- do i=itau_start,itau_end
-#else
- do i=4,nres
-#endif
- if ((itype(i-1).eq.21).or.(itype(i-1).eq.10)) cycle
-c the conventional case
- sint=dsin(omicron(1,i))
- sint1=dsin(theta(i-1))
- sing=dsin(tauangle(2,i))
- cost=dcos(omicron(1,i))
- cost1=dcos(theta(i-1))
- cosg=dcos(tauangle(2,i))
-c do j=1,3
-c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
-c enddo
- scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
-c Obtaining the gamma derivatives from sine derivative
- if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or.
- & tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or.
- & tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
- call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
- call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1)
- & +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
-c write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
-c &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
- dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
- dsintau(j,2,2,i)=
- & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i))
- & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
-c write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
-c & sing*ctgt*domicron(j,1,2,i),
-c & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
-c Bug fixed 3/24/05 (AL)
- dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i)
- & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
-c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
- enddo
-c Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3*
- & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp*
- & dc_norm(j,i-3))/vbld(i-2)
- dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
- dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2*
- & dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4*
- & dcosomicron(j,1,1,i)
- dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
- dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4*
- & dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp*
- & dc_norm(j,i-1+nres))/vbld(i-1+nres)
- dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
-c write(iout,*) i,j,"else", dtauangle(j,2,3,i)
- enddo
- endif
- enddo
-
-
-CCC third case SC...Ca...Ca...SC
-#ifdef PARINTDER
-
- do i=itau_start,itau_end
-#else
- do i=3,nres
-#endif
-c the conventional case
- if ((itype(i-1).eq.21).or.(itype(i-1).eq.10).or.
- &(itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle
- sint=dsin(omicron(1,i))
- sint1=dsin(omicron(2,i-1))
- sing=dsin(tauangle(3,i))
- cost=dcos(omicron(1,i))
- cost1=dcos(omicron(2,i-1))
- cosg=dcos(tauangle(3,i))
- do j=1,3
- dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
-c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
- enddo
- scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
- fac0=1.0d0/(sint1*sint)
- fac1=cost*fac0
- fac2=cost1*fac0
- fac3=cosg*cost1/(sint1*sint1)
- fac4=cosg*cost/(sint*sint)
-c Obtaining the gamma derivatives from sine derivative
- if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or.
- & tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or.
- & tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
- call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
- call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
- do j=1,3
- ctgt=cost/sint
- ctgt1=cost1/sint1
- cosg_inv=1.0d0/cosg
- dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1)
- & -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres))
- & *vbld_inv(i-2+nres)
- dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
- dsintau(j,3,2,i)=
- & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i))
- & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
- dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
-c Bug fixed 3/24/05 (AL)
- dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i)
- & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))
- & *vbld_inv(i-1+nres)
-c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
- dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
- enddo
-c Obtaining the gamma derivatives from cosine derivative
- else
- do j=1,3
- dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3*
- & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp*
- & dc_norm2(j,i-2+nres))/vbld(i-2+nres)
- dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
- dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2*
- & dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4*
- & dcosomicron(j,1,1,i)
- dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
- dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4*
- & dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp*
- & dc_norm(j,i-1+nres))/vbld(i-1+nres)
- dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
-c write(iout,*) "else",i
- enddo
- endif
- enddo
-#ifdef CRYST_SC
-c Derivatives of side-chain angles alpha and omega
-#if defined(MPI) && defined(PARINTDER)
- do i=ibond_start,ibond_end
-#else
- do i=2,nres-1
-#endif
- if(itype(i).ne.10) then
- fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
- fac6=fac5/vbld(i)
- fac7=fac5*fac5
- fac8=fac5/vbld(i+1)
- fac9=fac5/vbld(i+nres)
- scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
- scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
- cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))*(
- & scalar(dC_norm(1,i),dC_norm(1,i+nres))
- & -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
- sina=sqrt(1-cosa*cosa)
- sino=dsin(omeg(i))
- do j=1,3
- dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)-
- & dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
- dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
- dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)-
- & scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
- dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
- dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)-
- & dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/
- & vbld(i+nres))
- dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
- enddo
-c obtaining the derivatives of omega from sines
- if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or.
- & omeg(i).gt.pi34.and.omeg(i).le.pi.or.
- & omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
- fac15=dcos(theta(i+1))/(dsin(theta(i+1))*
- & dsin(theta(i+1)))
- fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
- fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
- call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
- call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
- call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
- coso_inv=1.0d0/dcos(omeg(i))
- do j=1,3
- dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1)
- & +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)-(
- & sino*dc_norm(j,i-1))/vbld(i)
- domega(j,1,i)=coso_inv*dsinomega(j,1,i)
- dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1)
- & +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j)
- & -sino*dc_norm(j,i)/vbld(i+1)
- domega(j,2,i)=coso_inv*dsinomega(j,2,i)
- dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)-
- & fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/
- & vbld(i+nres)
- domega(j,3,i)=coso_inv*dsinomega(j,3,i)
- enddo
- else
-c obtaining the derivatives of omega from cosines
- fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
- fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
- fac12=fac10*sina
- fac13=fac12*fac12
- fac14=sina*sina
- do j=1,3
- dcosomega(j,1,i)=(-(0.25d0*cosa/fac11*
- & dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+
- & (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina*
- & fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
- domega(j,1,i)=-1/sino*dcosomega(j,1,i)
- dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2*
- & dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11*
- & dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+
- & (scala2-fac11*cosa)*(0.25d0*sina/fac10*
- & dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)
- & ))/fac13
- domega(j,2,i)=-1/sino*dcosomega(j,2,i)
- dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)-
- & scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+
- & (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
- domega(j,3,i)=-1/sino*dcosomega(j,3,i)
- enddo
- endif
- endif
- enddo
-#endif
-#if defined(MPI) && defined(PARINTDER)
- if (nfgtasks.gt.1) then
-#ifdef DEBUG
- write (iout,*) "Gather dtheta"
-cd call flush(iout)
-c write (iout,*) "dtheta before gather"
-c do i=1,nres
-c write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
-c enddo
-#endif
- call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),
- & MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,
- & king,FG_COMM,IERROR)
-#ifdef DEBUG
-cd write (iout,*) "Gather dphi"
-cd call flush(iout)
- write (iout,*) "dphi before gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
- enddo
-#endif
- call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),
- & MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,
- & king,FG_COMM,IERROR)
-cd write (iout,*) "Gather dalpha"
-cd call flush(iout)
-#ifdef CRYST_SC
- call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),
- & MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,
- & king,FG_COMM,IERROR)
-cd write (iout,*) "Gather domega"
-cd call flush(iout)
- call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),
- & MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,
- & king,FG_COMM,IERROR)
-#endif
- endif
-#endif
-#ifdef DEBUG
- write (iout,*) "dtheta after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),j=1,2)
- enddo
- write (iout,*) "dphi after gather"
- do i=1,nres
- write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
- enddo
-#endif
- return
- end
-
- subroutine checkintcartgrad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.INTERACT'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.SETUP'
- double precision dthetanum(3,2,maxres),dphinum(3,3,maxres)
- & ,dalphanum(3,3,maxres), domeganum(3,3,maxres)
- double precision theta_s(maxres),phi_s(maxres),alph_s(maxres),
- & omeg_s(maxres),dc_norm_s(3)
- double precision aincr /1.0d-5/
-
- do i=1,nres
- phi_s(i)=phi(i)
- theta_s(i)=theta(i)
- alph_s(i)=alph(i)
- omeg_s(i)=omeg(i)
- enddo
-c Check theta gradient
- write (iout,*)
- & "Analytical (upper) and numerical (lower) gradient of theta"
- write (iout,*)
- do i=3,nres
- do j=1,3
- dcji=dc(j,i-2)
- dc(j,i-2)=dcji+aincr
- call chainbuild_cart
- call int_from_cart1(.false.)
- dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
- write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),
- & (dtheta(j,2,i),j=1,3)
- write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),
- & (dthetanum(j,2,i),j=1,3)
- write (iout,'(5x,3f10.5,5x,3f10.5)')
- & (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),
- & (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
- write (iout,*)
- enddo
-c Check gamma gradient
- write (iout,*)
- & "Analytical (upper) and numerical (lower) gradient of gamma"
- do i=4,nres
- do j=1,3
- dcji=dc(j,i-3)
- dc(j,i-3)=dcji+aincr
- call chainbuild_cart
- dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-3)=dcji
- dcji=dc(j,i-2)
- dc(j,i-2)=dcji+aincr
- call chainbuild_cart
- dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-2)=dcji
- dcji=dc(j,i-1)
- dc(j,i-1)=dc(j,i-1)+aincr
- call chainbuild_cart
- dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
- dc(j,i-1)=dcji
- enddo
- write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),
- & (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
- write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),
- & (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
- write (iout,'(5x,3(3f10.5,5x))')
- & (dphinum(j,1,i)/dphi(j,1,i),j=1,3),
- & (dphinum(j,2,i)/dphi(j,2,i),j=1,3),
- & (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
- write (iout,*)
- enddo
-c Check alpha gradient
- write (iout,*)
- & "Analytical (upper) and numerical (lower) gradient of alpha"
- do i=2,nres-1
- if(itype(i).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,1,i)=(alph(i)-alph_s(i))
- & /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- dalphanum(j,2,i)=(alph(i)-alph_s(i))
- & /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- dalphanum(j,3,i)=(alph(i)-alph_s(i))
- & /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
- write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),
- & (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
- write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),
- & (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
- write (iout,'(5x,3(3f10.5,5x))')
- & (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),
- & (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),
- & (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
- write (iout,*)
- enddo
-c Check omega gradient
- write (iout,*)
- & "Analytical (upper) and numerical (lower) gradient of omega"
- do i=2,nres-1
- if(itype(i).ne.10) then
- do j=1,3
- dcji=dc(j,i-1)
- dc(j,i-1)=dcji+aincr
- call chainbuild_cart
- domeganum(j,1,i)=(omeg(i)-omeg_s(i))
- & /aincr
- dc(j,i-1)=dcji
- dcji=dc(j,i)
- dc(j,i)=dcji+aincr
- call chainbuild_cart
- domeganum(j,2,i)=(omeg(i)-omeg_s(i))
- & /aincr
- dc(j,i)=dcji
- dcji=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+aincr
- call chainbuild_cart
- domeganum(j,3,i)=(omeg(i)-omeg_s(i))
- & /aincr
- dc(j,i+nres)=dcji
- enddo
- endif
- write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),
- & (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
- write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),
- & (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
- write (iout,'(5x,3(3f10.5,5x))')
- & (domeganum(j,1,i)/domega(j,1,i),j=1,3),
- & (domeganum(j,2,i)/domega(j,2,i),j=1,3),
- & (domeganum(j,3,i)/domega(j,3,i),j=1,3)
- write (iout,*)
- enddo
- return
- end
-
- subroutine chainbuild_cart
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.LOCAL'
- include 'COMMON.TIME1'
- include 'COMMON.IOUNITS'
-
-#ifdef MPI
- if (nfgtasks.gt.1) then
-c write (iout,*) "BCAST in chainbuild_cart"
-c call flush(iout)
-c Broadcast the order to build the chain and compute internal coordinates
-c to the slaves. The slaves receive the order in ERGASTULUM.
- time00=MPI_Wtime()
-c write (iout,*) "CHAINBUILD_CART: DC before BCAST"
-c do i=0,nres
-c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3),
-c & (dc(j,i+nres),j=1,3)
-c enddo
- if (fg_rank.eq.0)
- & call MPI_Bcast(7,1,MPI_INTEGER,king,FG_COMM,IERROR)
- time_bcast7=time_bcast7+MPI_Wtime()-time00
- time01=MPI_Wtime()
- call MPI_Bcast(dc(1,0),6*(nres+1),MPI_DOUBLE_PRECISION,
- & king,FG_COMM,IERR)
-c write (iout,*) "CHAINBUILD_CART: DC after BCAST"
-c do i=0,nres
-c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3),
-c & (dc(j,i+nres),j=1,3)
-c enddo
-c write (iout,*) "End BCAST in chainbuild_cart"
-c call flush(iout)
- time_bcast=time_bcast+MPI_Wtime()-time00
- time_bcastc=time_bcastc+MPI_Wtime()-time01
- endif
-#endif
- do j=1,3
- c(j,1)=dc(j,0)
- enddo
- do i=2,nres
- do j=1,3
- c(j,i)=c(j,i-1)+dc(j,i-1)
- enddo
- enddo
- do i=1,nres
- do j=1,3
- c(j,i+nres)=c(j,i)+dc(j,i+nres)
- enddo
- enddo
-c write (iout,*) "CHAINBUILD_CART"
-c call cartprint
- call int_from_cart1(.false.)
- return
- end
+++ /dev/null
-C
-C------------------------------------------------------------------------------
-C
- double precision function alpha(i1,i2,i3)
-c
-c Calculates the planar angle between atoms (i1), (i2), and (i3).
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- x12=c(1,i1)-c(1,i2)
- x23=c(1,i3)-c(1,i2)
- y12=c(2,i1)-c(2,i2)
- y23=c(2,i3)-c(2,i2)
- z12=c(3,i1)-c(3,i2)
- z23=c(3,i3)-c(3,i2)
- vnorm=dsqrt(x12*x12+y12*y12+z12*z12)
- wnorm=dsqrt(x23*x23+y23*y23+z23*z23)
- scalar=(x12*x23+y12*y23+z12*z23)/(vnorm*wnorm)
- alpha=arcos(scalar)
- return
- end
-C
-C------------------------------------------------------------------------------
-C
- double precision function beta(i1,i2,i3,i4)
-c
-c Calculates the dihedral angle between atoms (i1), (i2), (i3) and (i4)
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- x12=c(1,i1)-c(1,i2)
- x23=c(1,i3)-c(1,i2)
- x34=c(1,i4)-c(1,i3)
- y12=c(2,i1)-c(2,i2)
- y23=c(2,i3)-c(2,i2)
- y34=c(2,i4)-c(2,i3)
- z12=c(3,i1)-c(3,i2)
- z23=c(3,i3)-c(3,i2)
- z34=c(3,i4)-c(3,i3)
-cd print '(2i3,3f10.5)',i1,i2,x12,y12,z12
-cd print '(2i3,3f10.5)',i2,i3,x23,y23,z23
-cd print '(2i3,3f10.5)',i3,i4,x34,y34,z34
- wx=-y23*z34+y34*z23
- wy=x23*z34-z23*x34
- wz=-x23*y34+y23*x34
- wnorm=dsqrt(wx*wx+wy*wy+wz*wz)
- vx=y12*z23-z12*y23
- vy=-x12*z23+z12*x23
- vz=x12*y23-y12*x23
- vnorm=dsqrt(vx*vx+vy*vy+vz*vz)
- if (vnorm.gt.1.0D-13 .and. wnorm.gt.1.0D-13) then
- scalar=(vx*wx+vy*wy+vz*wz)/(vnorm*wnorm)
- if (dabs(scalar).gt.1.0D0)
- &scalar=0.99999999999999D0*scalar/dabs(scalar)
- angle=dacos(scalar)
-cd print '(2i4,10f7.3)',i2,i3,vx,vy,vz,wx,wy,wz,vnorm,wnorm,
-cd &scalar,angle
- else
- angle=pi
- endif
-c if (angle.le.0.0D0) angle=pi+angle
- tx=vy*wz-vz*wy
- ty=-vx*wz+vz*wx
- tz=vx*wy-vy*wx
- scalar=tx*x23+ty*y23+tz*z23
- if (scalar.lt.0.0D0) angle=-angle
- beta=angle
- return
- end
-C
-C------------------------------------------------------------------------------
-C
- function dist(i1,i2)
-c
-c Calculates the distance between atoms (i1) and (i2).
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- x12=c(1,i1)-c(1,i2)
- y12=c(2,i1)-c(2,i2)
- z12=c(3,i1)-c(3,i2)
- dist=dsqrt(x12*x12+y12*y12+z12*z12)
- return
- end
-C
+++ /dev/null
- subroutine integral(gamma1,gamma2,gamma3,gamma4,ity1,ity2,a1,a2,
- & si1,si2,si3,si4,transp,q)
- implicit none
- integer ity1,ity2
- integer ilam1,ilam2,ilam3,ilam4,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4
- logical transp
- double precision elocal,ele
- double precision delta,delta2,sum,ene,sumene,boltz
- double precision q,a1(2,2),a2(2,2),si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=20
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) gamma1,gamma2,ity1,ity2,a1,a2,si1,si2,si3,si4,transp
-
-cd do ilam1=-180,180,5
-cd do ilam2=-180,180,5
-cd lambda1=ilam1*conv+delta2
-cd lambda2=ilam2*conv+delta2
-cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2),
-cd & ele(lambda1,lambda2,a1,1.0d0,1.d00)
-cd enddo
-cd enddo
-cd stop
-
- sum=0.0d0
- sumene=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
-cd write (2,*) ilam1,ilam2,ilam3,ilam4
-cd write (2,*) lambda1,lambda2,lambda3,lambda4
- ene=
- & -elocal(ity1,lambda1,lambda2,.false.)*
- & elocal(ity2,lambda3,lambda4,transp)*
- & ele(si1*lambda1+gamma1,si3*lambda3+gamma3,a1)*
- & ele(si2*lambda2+gamma2,si4*lambda4+gamma4,a2)
-cd write (2,*) elocal(ity1,lambda1,gamma1-pi-lambda2),
-cd & elocal(ity2,lambda3,gamma2-pi-lambda4),
-cd & ele(lambda1,lambda2,a1,si1,si3),
-cd & ele(lambda3,lambda4,a2,si2,si4)
- sum=sum+ene
- enddo
- enddo
- enddo
- enddo
- q=sum/(2*pi)**4*delta**4
- write (2,* )'sum',sum,' q',q
- return
- end
-c---------------------------------------------------------------------------
- subroutine integral3(gamma1,gamma2,ity1,ity2,ity3,ity4,
- & a1,koniec,q1,q2,q3,q4)
- implicit none
- integer ity1,ity2,ity3,ity4
- integer ilam1,ilam2,ilam3,ilam4,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,lambda1,
- & lambda2,lambda3,lambda4
- logical koniec
- double precision elocal,ele
- double precision delta,delta2,sum1,sum2,sum3,sum4,
- & ene1,ene2,ene3,ene4,boltz
- double precision q1,q2,q3,q4,a1(2,2),a2(2,2)
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
- write(2,*) gamma1,gamma2,ity1,ity2,ity3,ity4,a1,koniec
-
-cd do ilam1=-180,180,5
-cd do ilam2=-180,180,5
-cd lambda1=ilam1*conv+delta2
-cd lambda2=ilam2*conv+delta2
-cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2),
-cd & ele(lambda1,lambda2,a1,1.0d0,1.d00)
-cd enddo
-cd enddo
-cd stop
-
- sum1=0.0d0
- sum2=0.0d0
- sum3=0.0d0
- sum4=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
-cd write (2,*) ilam1,ilam2,ilam3,ilam4
-cd write (2,*) lambda1,lambda2,lambda3,lambda4
- if (.not.koniec) then
- ene1=
- & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)*
- & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)*
- & ele(lambda2,lambda4,a1)
- else
- ene1=
- & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)*
- & elocal(ity3,lambda3,lambda4,.false.)*
- & ele(lambda2,-lambda4,a1)
- endif
- ene2=
- & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)*
- & elocal(ity4,lambda3,lambda4,.false.)*
- & ele(lambda2,lambda3,a1)
- if (.not.koniec) then
- ene3=
- & elocal(ity2,lambda1,lambda2,.false.)*
- & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)*
- & ele(lambda1,lambda4,a1)
- else
- ene3=
- & elocal(ity2,lambda1,lambda2,.false.)*
- & elocal(ity3,lambda3,lambda4,.false.)*
- & ele(lambda1,-lambda4,a1)
- endif
- ene4=
- & elocal(ity2,lambda1,lambda2,.false.)*
- & elocal(ity4,lambda3,lambda4,.false.)*
- & ele(lambda1,lambda3,a1)
- sum1=sum1+ene1
- sum2=sum2+ene2
- sum3=sum3+ene3
- sum4=sum4+ene4
- enddo
- enddo
- enddo
- enddo
- q1=sum1/(2*pi)**4*delta**4
- q2=sum2/(2*pi)**4*delta**4
- q3=sum3/(2*pi)**4*delta**4
- q4=sum4/(2*pi)**4*delta**4
- write (2,* )'sum',sum1,sum2,sum3,sum4,' q',q1,q2,q3,q4
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral5(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3,
- & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc5,eloc6,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom
- double precision ene1,ene2,ene3,ene4,sum1,sum2,sum3,sum4,
- & a1(2,2),a2(2,2)
- integer si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2,
-cd & ' gamma3=',gamma3,' gamma4=',gamma4
-cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6
-cd write(2,*) 'a1=',a1
-cd write(2,*) 'a2=',a2
-cd write(2,*) si1,si2,si3,si4,transp
-
- sum1=0.0d0
- sum2=0.0d0
- sum3=0.0d0
- sum4=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- do ilam5=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
- lambda5=ilam5*conv+delta2
- if (transp) then
- ele1=ele(lambda1,si4*lambda4,a1)
- ele2=ele(lambda2,lambda3,a2)
- else
- ele1=ele(lambda1,lambda3,a1)
- ele2=ele(lambda2,si4*lambda4,a2)
- endif
- eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.)
- eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.)
- pom=ele1*ele2*eloc2*eloc5
- if (si1.gt.0) then
- eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.)
- sum1=sum1+pom*eloc1
- endif
- eloc3=elocal(ity3,lambda2,lambda5,.false.)
- sum2=sum2+pom*eloc3
- eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.)
- sum3=sum3+pom*eloc4
- if (si4.gt.0) then
- eloc6=elocal(ity6,lambda4,lambda5,.false.)
- sum4=sum4+pom*eloc6
- endif
- enddo
- enddo
- enddo
- enddo
- enddo
- pom=1.0d0/(2*pi)**5*delta**5
- ene1=sum1*pom
- ene2=sum2*pom
- ene3=sum3*pom
- ene4=sum4*pom
-c write (2,* )'sum',sum1,sum2,sum3,sum4,' q',ene1,ene2,ene3,ene4
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral_turn6(gamma1,gamma2,gamma3,gamma4,ity1,ity2,
- & ity3,ity4,ity5,ity6,a1,a2,ene_turn6)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5,lambda6
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6,
- & eloc61,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom,ene5
- double precision ene_turn6,sum5,a1(2,2),a2(2,2)
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
- write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2,
- & ' gamma3=',gamma3,' gamma4=',gamma4
- write(2,*) ity1,ity2,ity3,ity4,ity5,ity6
- write(2,*) 'a1=',a1
- write(2,*) 'a2=',a2
-
- sum5=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- do ilam5=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
- lambda5=ilam5*conv+delta2
- ele1=ele(lambda1,-lambda4,a1)
- ele2=ele(lambda2,lambda3,a2)
- eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.)
- eloc5=elocal(ity5,lambda3,lambda4,.false.)
- pom=ele1*ele2*eloc2*eloc5
- eloc3=elocal(ity3,lambda2,gamma3-pi-lambda5,.false.)
- eloc4=elocal(ity4,lambda5,gamma4-pi-lambda3,.false.)
- sum5=sum5+pom*eloc3*eloc4
- enddo
- enddo
- enddo
- enddo
- enddo
- pom=-1.0d0/(2*pi)**5*delta**5
- ene_turn6=sum5*pom
-c print *,'sum6',sum6,' ene6',ene6
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral6(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3,
- & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4,
- & ene5,ene6)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5,lambda6
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6,
- & eloc61,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom
- double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3,
- & sum4,sum5,sum6,a1(2,2),a2(2,2)
- integer si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2,
-cd & ' gamma3=',gamma3,' gamma4=',gamma4
-cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6
-cd write(2,*) 'a1=',a1
-cd write(2,*) 'a2=',a2
-cd write(2,*) si1,si2,si3,si4,transp
-
- sum1=0.0d0
- sum2=0.0d0
- sum3=0.0d0
- sum4=0.0d0
- sum5=0.0d0
- sum6=0.0d0
- eloc1=0.0d0
- eloc6=0.0d0
- eloc61=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- do ilam5=-180,179,iincr
- do ilam6=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
- lambda5=ilam5*conv+delta2
- lambda6=ilam6*conv+delta2
- if (transp) then
- ele1=ele(lambda1,si4*lambda4,a1)
- ele2=ele(lambda2,lambda3,a2)
- else
- ele1=ele(lambda1,lambda3,a1)
- ele2=ele(lambda2,si4*lambda4,a2)
- endif
- eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.)
- eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.)
- pom=ele1*ele2*eloc2*eloc5
- if (si1.gt.0) then
- eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.)
- endif
- eloc3=elocal(ity3,lambda2,lambda6,.false.)
- sum1=sum1+pom*eloc1*eloc3
- eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.)
- if (si4.gt.0) then
- eloc6=elocal(ity6,lambda4,lambda6,.false.)
- eloc61=elocal(ity6,lambda4,lambda5,.false.)
- endif
- sum2=sum2+pom*eloc4*eloc6
- eloc41=elocal(ity4,lambda6,gamma3-pi-lambda3,.false.)
- sum3=sum3+pom*eloc1*eloc41
- sum4=sum4+pom*eloc1*eloc6
- sum5=sum5+pom*eloc3*eloc4
- sum6=sum6+pom*eloc3*eloc61
- enddo
- enddo
- enddo
- enddo
- enddo
- enddo
- pom=-1.0d0/(2*pi)**6*delta**6
- ene1=sum1*pom
- ene2=sum2*pom
- ene3=sum3*pom
- ene4=sum4*pom
- ene5=sum5*pom
- ene6=sum6*pom
-c print *,'sum6',sum6,' ene6',ene6
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral3a(gamma1,gamma2,ity1,ity2,a1,si1,ene1)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5,lambda6
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6,
- & eloc61,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom
- double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3,
- & sum4,sum5,sum6,a1(2,2),a2(2,2)
- integer si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2
-cd write(2,*) ity1,ity2
-cd write(2,*) 'a1=',a1
-cd write(2,*) si1,
-
- sum1=0.0d0
- eloc1=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- ele1=ele(lambda1,si1*lambda3,a1)
- eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)
- if (si1.gt.0) then
- eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.)
- else
- eloc2=elocal(ity2,lambda2,lambda3,.false.)
- endif
- sum1=sum1+ele1*eloc1*eloc2
- enddo
- enddo
- enddo
- pom=1.0d0/(2*pi)**3*delta**3
- ene1=sum1*pom
- return
- end
-c-------------------------------------------------------------------------
- subroutine integral4a(gamma1,gamma2,gamma3,ity1,ity2,ity3,a1,si1,
- & ene1)
- implicit none
- integer ity1,ity2,ity3,ity4,ity5,ity6
- integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr
- double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1,
- & lambda2,lambda3,lambda4,lambda5,lambda6
- logical transp
- double precision elocal,ele
- double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6,
- & eloc61,ele1,ele2
- double precision delta,delta2,sum,ene,sumene,pom
- double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3,
- & sum4,sum5,sum6,a1(2,2),a2(2,2)
- integer si1,si2,si3,si4
- double precision conv /.01745329252d0/,pi /3.141592654d0/
-
- iincr=60
- delta=iincr*conv
- delta2=0.5d0*delta
-cd print *,'iincr',iincr,' delta',delta
-cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2,
-cd & ' gamma3=',gamma3
-cd write(2,*) ity1,ity2,ity3
-cd write(2,*) 'a1=',a1
-cd write(2,*) 'si1=',si1
- sum1=0.0d0
- do ilam1=-180,179,iincr
- do ilam2=-180,179,iincr
- do ilam3=-180,179,iincr
- do ilam4=-180,179,iincr
- lambda1=ilam1*conv+delta2
- lambda2=ilam2*conv+delta2
- lambda3=ilam3*conv+delta2
- lambda4=ilam4*conv+delta2
- ele1=ele(lambda1,si1*lambda4,a1)
- eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)
- eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.)
- if (si1.gt.0) then
- eloc3=elocal(ity3,lambda3,gamma3-pi-lambda4,.false.)
- else
- eloc3=elocal(ity3,lambda3,lambda4,.false.)
- endif
- sum1=sum1+ele1*eloc1*eloc2*eloc3
- enddo
- enddo
- enddo
- enddo
- pom=-1.0d0/(2*pi)**4*delta**4
- ene1=sum1*pom
- return
- end
-c-------------------------------------------------------------------------
- double precision function elocal(i,x,y,transp)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.TORSION'
- integer i
- double precision x,y,u(2),v(2),cu(2),dv(2),ev(2)
- double precision scalar2
- logical transp
- u(1)=dcos(x)
- u(2)=dsin(x)
- v(1)=dcos(y)
- v(2)=dsin(y)
- if (transp) then
- call matvec2(cc(1,1,i),v,cu)
- call matvec2(dd(1,1,i),u,dv)
- call matvec2(ee(1,1,i),u,ev)
- elocal=scalar2(b1(1,i),v)+scalar2(b2(1,i),u)+scalar2(cu,v)+
- & scalar2(dv,u)+scalar2(ev,v)
- else
- call matvec2(cc(1,1,i),u,cu)
- call matvec2(dd(1,1,i),v,dv)
- call matvec2(ee(1,1,i),v,ev)
- elocal=scalar2(b1(1,i),u)+scalar2(b2(1,i),v)+scalar2(cu,u)+
- & scalar2(dv,v)+scalar2(ev,u)
- endif
- return
- end
-c-------------------------------------------------------------------------
- double precision function ele(x,y,a)
- implicit none
- double precision x,y,a(2,2),si1,si2,u(2),v(2),av(2)
- double precision scalar2
- u(1)=-cos(x)
- u(2)= sin(x)
- v(1)=-cos(y)
- v(2)= sin(y)
- call matvec2(a,v,av)
- ele=scalar2(u,av)
- return
- end
+++ /dev/null
- subroutine kinetic(KE_total)
-c----------------------------------------------------------------
-c This subroutine calculates the total kinetic energy of the chain
-c-----------------------------------------------------------------
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- double precision KE_total
-
- integer i,j,k
- double precision KEt_p,KEt_sc,KEr_p,KEr_sc,incr(3),
- & mag1,mag2,v(3)
-
- KEt_p=0.0d0
- KEt_sc=0.0d0
-c write (iout,*) "ISC",(isc(itype(i)),i=1,nres)
-c The translational part for peptide virtual bonds
- do j=1,3
- incr(j)=d_t(j,0)
- enddo
- do i=nnt,nct-1
-c write (iout,*) "Kinetic trp:",i,(incr(j),j=1,3)
- do j=1,3
- v(j)=incr(j)+0.5d0*d_t(j,i)
- enddo
- vtot(i)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3)
- KEt_p=KEt_p+(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))
- do j=1,3
- incr(j)=incr(j)+d_t(j,i)
- enddo
- enddo
-c write(iout,*) 'KEt_p', KEt_p
-c The translational part for the side chain virtual bond
-c Only now we can initialize incr with zeros. It must be equal
-c to the velocities of the first Calpha.
- do j=1,3
- incr(j)=d_t(j,0)
- enddo
- do i=nnt,nct
- iti=itype(i)
- if (itype(i).eq.10) then
- do j=1,3
- v(j)=incr(j)
- enddo
- else
- do j=1,3
- v(j)=incr(j)+d_t(j,nres+i)
- enddo
- endif
-c write (iout,*) "Kinetic trsc:",i,(incr(j),j=1,3)
-c write (iout,*) "i",i," msc",msc(iti)," v",(v(j),j=1,3)
- KEt_sc=KEt_sc+msc(iti)*(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))
- vtot(i+nres)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3)
- do j=1,3
- incr(j)=incr(j)+d_t(j,i)
- enddo
- enddo
-c goto 111
-c write(iout,*) 'KEt_sc', KEt_sc
-c The part due to stretching and rotation of the peptide groups
- KEr_p=0.0D0
- do i=nnt,nct-1
-c write (iout,*) "i",i
-c write (iout,*) "i",i," mag1",mag1," mag2",mag2
- do j=1,3
- incr(j)=d_t(j,i)
- enddo
-c write (iout,*) "Kinetic rotp:",i,(incr(j),j=1,3)
- KEr_p=KEr_p+(incr(1)*incr(1)+incr(2)*incr(2)
- & +incr(3)*incr(3))
- enddo
-c goto 111
-c write(iout,*) 'KEr_p', KEr_p
-c The rotational part of the side chain virtual bond
- KEr_sc=0.0D0
- do i=nnt,nct
- iti=itype(i)
- if (itype(i).ne.10) then
- do j=1,3
- incr(j)=d_t(j,nres+i)
- enddo
-c write (iout,*) "Kinetic rotsc:",i,(incr(j),j=1,3)
- KEr_sc=KEr_sc+Isc(iti)*(incr(1)*incr(1)+incr(2)*incr(2)+
- & incr(3)*incr(3))
- endif
- enddo
-c The total kinetic energy
- 111 continue
-c write(iout,*) 'KEr_sc', KEr_sc
- KE_total=0.5d0*(mp*KEt_p+KEt_sc+0.25d0*Ip*KEr_p+KEr_sc)
-c write (iout,*) "KE_total",KE_total
- return
- end
-
-
-
-
+++ /dev/null
- subroutine lagrangian
-c-------------------------------------------------------------------------
-c This subroutine contains the total lagrangain from which the accelerations
-c are obtained. For numerical gradient checking, the derivetive of the
-c lagrangian in the velocities and coordinates are calculated seperately
-c-------------------------------------------------------------------------
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- include 'COMMON.MUCA'
- include 'COMMON.TIME1'
-
- integer i,j,ind
- double precision zapas(MAXRES6),muca_factor
- logical lprn /.false./
- common /cipiszcze/ itime
-
-#ifdef TIMING
- time00=MPI_Wtime()
-#endif
- do j=1,3
- zapas(j)=-gcart(j,0)
- enddo
- ind=3
- if (lprn) then
- write (iout,*) "Potential forces backbone"
- endif
- do i=nnt,nct-1
- if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)')
- & i,(-gcart(j,i),j=1,3)
- do j=1,3
- ind=ind+1
- zapas(ind)=-gcart(j,i)
- enddo
- enddo
- if (lprn) write (iout,*) "Potential forces sidechain"
- do i=nnt,nct
- if (itype(i).ne.10) then
- if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)')
- & i,(-gcart(j,i),j=1,3)
- do j=1,3
- ind=ind+1
- zapas(ind)=-gxcart(j,i)
- enddo
- endif
- enddo
-
- call ginv_mult(zapas,d_a_work)
-
- do j=1,3
- d_a(j,0)=d_a_work(j)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- ind=ind+1
- d_a(j,i)=d_a_work(ind)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- ind=ind+1
- d_a(j,i+nres)=d_a_work(ind)
- enddo
- endif
- enddo
-
- if(lmuca) then
- imtime=imtime+1
- if(mucadyn.gt.0) call muca_update(potE)
- factor=muca_factor(potE)*t_bath*Rb
-
-cd print *,'lmuca ',factor,potE
- do j=1,3
- d_a(j,0)=d_a(j,0)*factor
- enddo
- do i=nnt,nct-1
- do j=1,3
- d_a(j,i)=d_a(j,i)*factor
- enddo
- enddo
- do i=nnt,nct
- do j=1,3
- d_a(j,i+nres)=d_a(j,i+nres)*factor
- enddo
- enddo
-
- endif
-
- if (lprn) then
- write(iout,*) 'acceleration 3D'
- write (iout,'(i3,3f10.5,3x,3f10.5)') 0,(d_a(j,0),j=1,3)
- do i=nnt,nct-1
- write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3)
- enddo
- do i=nnt,nct
- write (iout,'(i3,3f10.5,3x,3f10.5)')
- & i+nres,(d_a(j,i+nres),j=1,3)
- enddo
- endif
-#ifdef TIMING
- time_lagrangian=time_lagrangian+MPI_Wtime()-time00
-#endif
- return
- end
-c------------------------------------------------------------------
- subroutine setup_MD_matrices
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer ierror
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- integer i,j
- logical lprn /.false./
- logical osob
- double precision dtdi,massvec(maxres2),Gcopy(maxres2,maxres2),
- & Ghalf(mmaxres2),sqreig(maxres2), invsqreig(maxres2), Gcopytmp,
- & Gsqrptmp, Gsqrmtmp, Gvec2tmp,Gvectmp(maxres2,maxres2)
- double precision work(8*maxres6)
- integer iwork(maxres6)
- common /przechowalnia/ Gcopy,Ghalf,invsqreig,Gvectmp
-c
-c Set up the matrix of the (dC,dX)-->(C,X) transformation (A), the
-c inertia matrix (Gmat) and the inverse of the inertia matrix (Ginv)
-c
-c Determine the number of degrees of freedom (dimen) and the number of
-c sites (dimen1)
- dimen=(nct-nnt+1)+nside
- dimen1=(nct-nnt)+(nct-nnt+1)
- dimen3=dimen*3
-#ifdef MPI
- if (nfgtasks.gt.1) then
- time00=MPI_Wtime()
- call MPI_Bcast(5,1,MPI_INTEGER,king,FG_COMM,IERROR)
- time_Bcast=time_Bcast+MPI_Wtime()-time00
- call int_bounds(dimen,igmult_start,igmult_end)
- igmult_start=igmult_start-1
- call MPI_Allgather(3*igmult_start,1,MPI_INTEGER,
- & ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR)
- my_ng_count=igmult_end-igmult_start
- call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
- write (iout,*) 'Processor:',fg_rank,' CG group',kolor,
- & ' absolute rank',myrank,' igmult_start',igmult_start,
- & ' igmult_end',igmult_end,' count',my_ng_count
- write (iout,*) "ng_start",(ng_start(i),i=0,nfgtasks-1)
- write (iout,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1)
- call flush(iout)
- else
-#endif
- igmult_start=1
- igmult_end=dimen
- my_ng_count=dimen
-#ifdef MPI
- endif
-#endif
-c write (iout,*) "dimen",dimen," dimen1",dimen1," dimen3",dimen3
-c Zeroing out A and fricmat
- do i=1,dimen
- do j=1,dimen
- A(i,j)=0.0D0
- enddo
- enddo
-c Diagonal elements of the dC part of A and the respective friction coefficients
- ind=1
- ind1=0
- do i=nnt,nct-1
- ind=ind+1
- ind1=ind1+1
- coeff=0.25d0*IP
- massvec(ind1)=mp
- Gmat(ind,ind)=coeff
- A(ind1,ind)=0.5d0
- enddo
-
-c Off-diagonal elements of the dC part of A
- k=3
- do i=1,nct-nnt
- do j=1,i
- A(i,j)=1.0d0
- enddo
- enddo
-c Diagonal elements of the dX part of A and the respective friction coefficients
- m=nct-nnt
- m1=nct-nnt+1
- ind=0
- ind1=0
- do i=nnt,nct
- ind=ind+1
- ii = ind+m
- iti=itype(i)
- massvec(ii)=msc(iti)
- if (iti.ne.10) then
- ind1=ind1+1
- ii1= ind1+m1
- A(ii,ii1)=1.0d0
- Gmat(ii1,ii1)=ISC(iti)
- endif
- enddo
-c Off-diagonal elements of the dX part of A
- ind=0
- k=nct-nnt
- do i=nnt,nct
- iti=itype(i)
- ind=ind+1
- do j=nnt,i
- ii = ind
- jj = j-nnt+1
- A(k+ii,jj)=1.0d0
- enddo
- enddo
- if (lprn) then
- write (iout,*)
- write (iout,*) "Vector massvec"
- do i=1,dimen1
- write (iout,*) i,massvec(i)
- enddo
- write (iout,'(//a)') "A"
- call matout(dimen,dimen1,maxres2,maxres2,A)
- endif
-
-c Calculate the G matrix (store in Gmat)
- do k=1,dimen
- do i=1,dimen
- dtdi=0.0d0
- do j=1,dimen1
- dtdi=dtdi+A(j,k)*A(j,i)*massvec(j)
- enddo
- Gmat(k,i)=Gmat(k,i)+dtdi
- enddo
- enddo
-
- if (lprn) then
- write (iout,'(//a)') "Gmat"
- call matout(dimen,dimen,maxres2,maxres2,Gmat)
- endif
- do i=1,dimen
- do j=1,dimen
- Ginv(i,j)=0.0d0
- Gcopy(i,j)=Gmat(i,j)
- enddo
- Ginv(i,i)=1.0d0
- enddo
-c Invert the G matrix
- call MATINVERT(dimen,maxres2,Gcopy,Ginv,osob)
- if (lprn) then
- write (iout,'(//a)') "Ginv"
- call matout(dimen,dimen,maxres2,maxres2,Ginv)
- endif
-#ifdef MPI
- if (nfgtasks.gt.1) then
- myginv_ng_count=maxres2*my_ng_count
- call MPI_Allgather(maxres2*igmult_start,1,MPI_INTEGER,
- & nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER,
- & nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR)
- if (lprn .and. (me.eq.king .or. .not. out1file) ) then
- write (iout,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1)
- write (iout,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1)
- call flush(iout)
- endif
-c call MPI_Scatterv(ginv(1,1),nginv_counts(0),
-c & nginv_start(0),MPI_DOUBLE_PRECISION,ginv,
-c & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR)
-c call MPI_Barrier(FG_COMM,IERR)
- time00=MPI_Wtime()
- call MPI_Scatterv(ginv(1,1),nginv_counts(0),
- & nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1),
- & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR)
-#ifdef TIMING
- time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00
-#endif
- do i=1,dimen
- do j=1,2*my_ng_count
- ginv(j,i)=gcopy(i,j)
- enddo
- enddo
-c write (iout,*) "Master's chunk of ginv"
-c call MATOUT2(my_ng_count,dimen,maxres2,maxres2,ginv)
- endif
-#endif
- if (osob) then
- write (iout,*) "The G matrix is singular."
- stop
- endif
-c Compute G**(-1/2) and G**(1/2)
- ind=0
- do i=1,dimen
- do j=1,i
- ind=ind+1
- Ghalf(ind)=Gmat(i,j)
- enddo
- enddo
- call gldiag(maxres2,dimen,dimen,Ghalf,work,Geigen,Gvec,
- & ierr,iwork)
- if (lprn) then
- write (iout,'(//a)')
- & "Eigenvectors and eigenvalues of the G matrix"
- call eigout(dimen,dimen,maxres2,maxres2,Gvec,Geigen)
- endif
-
- do i=1,dimen
- sqreig(i)=dsqrt(Geigen(i))
- invsqreig(i)=1.d0/sqreig(i)
- enddo
- do i=1,dimen
- do j=1,dimen
- Gvectmp(i,j)=Gvec(j,i)
- enddo
- enddo
-
- do i=1,dimen
- do j=1,dimen
- Gsqrptmp=0.0d0
- Gsqrmtmp=0.0d0
- Gcopytmp=0.0d0
- do k=1,dimen
-c Gvec2tmp=Gvec(i,k)*Gvec(j,k)
- Gvec2tmp=Gvec(k,i)*Gvec(k,j)
- Gsqrptmp=Gsqrptmp+Gvec2tmp*sqreig(k)
- Gsqrmtmp=Gsqrmtmp+Gvec2tmp*invsqreig(k)
- Gcopytmp=Gcopytmp+Gvec2tmp*Geigen(k)
- enddo
- Gsqrp(i,j)=Gsqrptmp
- Gsqrm(i,j)=Gsqrmtmp
- Gcopy(i,j)=Gcopytmp
- enddo
- enddo
-
- do i=1,dimen
- do j=1,dimen
- Gvec(i,j)=Gvectmp(j,i)
- enddo
- enddo
-
- if (lprn) then
- write (iout,*) "Comparison of original and restored G"
- do i=1,dimen
- do j=1,dimen
- write (iout,'(2i5,5f10.5)') i,j,Gmat(i,j),Gcopy(i,j),
- & Gmat(i,j)-Gcopy(i,j),Gsqrp(i,j),Gsqrm(i,j)
- enddo
- enddo
- endif
- return
- end
-c-------------------------------------------------------------------------------
- SUBROUTINE EIGOUT(NC,NR,LM2,LM3,A,B)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- double precision A(LM2,LM3),B(LM2)
- KA=1
- KC=6
- 1 KB=MIN0(KC,NC)
- WRITE(IOUT,600) (I,I=KA,KB)
- WRITE(IOUT,601) (B(I),I=KA,KB)
- WRITE(IOUT,602)
- 2 N=0
- DO 3 I=1,NR
- WRITE(IOUT,603) I,(A(I,J),J=KA,KB)
- N=N+1
- IF(N.LT.10) GO TO 3
- WRITE(IOUT,602)
- N=0
- 3 CONTINUE
- 4 IF (KB.EQ.NC) RETURN
- KA=KC+1
- KC=KC+6
- GO TO 1
- 600 FORMAT (// 9H ROOT NO.,I4,9I11)
- 601 FORMAT (/5X,10(1PE11.4))
- 602 FORMAT (2H )
- 603 FORMAT (I5,10F11.5)
- 604 FORMAT (1H1)
- END
-c-------------------------------------------------------------------------------
- SUBROUTINE MATOUT(NC,NR,LM2,LM3,A)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- double precision A(LM2,LM3)
- KA=1
- KC=6
- 1 KB=MIN0(KC,NC)
- WRITE(IOUT,600) (I,I=KA,KB)
- WRITE(IOUT,602)
- 2 N=0
- DO 3 I=1,NR
- WRITE(IOUT,603) I,(A(I,J),J=KA,KB)
- N=N+1
- IF(N.LT.10) GO TO 3
- WRITE(IOUT,602)
- N=0
- 3 CONTINUE
- 4 IF (KB.EQ.NC) RETURN
- KA=KC+1
- KC=KC+6
- GO TO 1
- 600 FORMAT (//5x,9I11)
- 602 FORMAT (2H )
- 603 FORMAT (I5,10F11.3)
- 604 FORMAT (1H1)
- END
-c-------------------------------------------------------------------------------
- SUBROUTINE MATOUT1(NC,NR,LM2,LM3,A)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- double precision A(LM2,LM3)
- KA=1
- KC=21
- 1 KB=MIN0(KC,NC)
- WRITE(IOUT,600) (I,I=KA,KB)
- WRITE(IOUT,602)
- 2 N=0
- DO 3 I=1,NR
- WRITE(IOUT,603) I,(A(I,J),J=KA,KB)
- N=N+1
- IF(N.LT.3) GO TO 3
- WRITE(IOUT,602)
- N=0
- 3 CONTINUE
- 4 IF (KB.EQ.NC) RETURN
- KA=KC+1
- KC=KC+21
- GO TO 1
- 600 FORMAT (//5x,7(3I5,2x))
- 602 FORMAT (2H )
- 603 FORMAT (I5,7(3F5.1,2x))
- 604 FORMAT (1H1)
- END
-c-------------------------------------------------------------------------------
- SUBROUTINE MATOUT2(NC,NR,LM2,LM3,A)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- double precision A(LM2,LM3)
- KA=1
- KC=12
- 1 KB=MIN0(KC,NC)
- WRITE(IOUT,600) (I,I=KA,KB)
- WRITE(IOUT,602)
- 2 N=0
- DO 3 I=1,NR
- WRITE(IOUT,603) I,(A(I,J),J=KA,KB)
- N=N+1
- IF(N.LT.3) GO TO 3
- WRITE(IOUT,602)
- N=0
- 3 CONTINUE
- 4 IF (KB.EQ.NC) RETURN
- KA=KC+1
- KC=KC+12
- GO TO 1
- 600 FORMAT (//5x,4(3I9,2x))
- 602 FORMAT (2H )
- 603 FORMAT (I5,4(3F9.3,2x))
- 604 FORMAT (1H1)
- END
-c---------------------------------------------------------------------------
- SUBROUTINE ginv_mult(z,d_a_tmp)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer ierr
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
- include 'COMMON.MD'
- double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00
- &time01
-#ifdef MPI
- if (nfgtasks.gt.1) then
- if (fg_rank.eq.0) then
-c The matching BROADCAST for fg processors is called in ERGASTULUM
- time00=MPI_Wtime()
- call MPI_Bcast(4,1,MPI_INTEGER,king,FG_COMM,IERROR)
- time_Bcast=time_Bcast+MPI_Wtime()-time00
-c print *,"Processor",myrank," BROADCAST iorder in GINV_MULT"
- endif
-c write (2,*) "time00",time00
-c write (2,*) "Before Scatterv"
-c call flush(2)
-c write (2,*) "Whole z (for FG master)"
-c do i=1,dimen
-c write (2,*) i,z(i)
-c enddo
-c call MPI_Barrier(FG_COMM,IERROR)
- time00=MPI_Wtime()
- call MPI_Scatterv(z,ng_counts(0),ng_start(0),
- & MPI_DOUBLE_PRECISION,
- & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR)
-c write (2,*) "My chunk of z"
-c do i=1,3*my_ng_count
-c write (2,*) i,z(i)
-c enddo
-c write (2,*) "After SCATTERV"
-c call flush(2)
-c write (2,*) "MPI_Wtime",MPI_Wtime()
- time_scatter=time_scatter+MPI_Wtime()-time00
-#ifdef TIMING
- time_scatter_ginvmult=time_scatter_ginvmult+MPI_Wtime()-time00
-#endif
-c write (2,*) "time_scatter",time_scatter
-c write (2,*) "dimen",dimen," dimen3",dimen3," my_ng_count",
-c & my_ng_count
-c call flush(2)
- time01=MPI_Wtime()
- do k=0,2
- do i=1,dimen
- ind=(i-1)*3+k+1
- temp(ind)=0.0d0
- do j=1,my_ng_count
-c write (2,*) "k,i,j,ind",k,i,j,ind,(j-1)*3+k+1,
-c & Ginv(i,j),z((j-1)*3+k+1),
-c & Ginv(i,j)*z((j-1)*3+k+1)
-c temp(ind)=temp(ind)+Ginv(i,j)*z((j-1)*3+k+1)
- temp(ind)=temp(ind)+Ginv(j,i)*z((j-1)*3+k+1)
- enddo
- enddo
- enddo
- time_ginvmult=time_ginvmult+MPI_Wtime()-time01
-c write (2,*) "Before REDUCE"
-c call flush(2)
-c write (2,*) "z before reduce"
-c do i=1,dimen
-c write (2,*) i,temp(i)
-c enddo
- time00=MPI_Wtime()
- call MPI_Reduce(temp(1),d_a_tmp(1),dimen3,MPI_DOUBLE_PRECISION,
- & MPI_SUM,king,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
-c write (2,*) "After REDUCE"
-c call flush(2)
- else
-#endif
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- do k=0,2
- do i=1,dimen
- ind=(i-1)*3+k+1
- d_a_tmp(ind)=0.0d0
- do j=1,dimen
-c write (2,*) "k,i,j,ind",k,i,j,ind,(j-1)*3+k+1
-c call flush(2)
-c & Ginv(i,j),z((j-1)*3+k+1),
-c & Ginv(i,j)*z((j-1)*3+k+1)
- d_a_tmp(ind)=d_a_tmp(ind)
- & +Ginv(j,i)*z((j-1)*3+k+1)
-c d_a_tmp(ind)=d_a_tmp(ind)
-c & +Ginv(i,j)*z((j-1)*3+k+1)
- enddo
- enddo
- enddo
-#ifdef TIMING
- time_ginvmult=time_ginvmult+MPI_Wtime()-time01
-#endif
-#ifdef MPI
- endif
-#endif
- return
- end
-c---------------------------------------------------------------------------
-#ifdef GINV_MULT
- SUBROUTINE ginv_mult_test(z,d_a_tmp)
- include 'DIMENSIONS'
- integer dimen
-c include 'COMMON.MD'
- double precision z(dimen),d_a_tmp(dimen)
- double precision ztmp(dimen/3),dtmp(dimen/3)
-
-c do i=1,dimen
-c d_a_tmp(i)=0.0d0
-c do j=1,dimen
-c d_a_tmp(i)=d_a_tmp(i)+Ginv(i,j)*z(j)
-c enddo
-c enddo
-c
-c return
-
-!ibm* unroll(3)
- do k=0,2
- do j=1,dimen/3
- ztmp(j)=z((j-1)*3+k+1)
- enddo
-
- call alignx(16,ztmp(1))
- call alignx(16,dtmp(1))
- call alignx(16,Ginv(1,1))
-
- do i=1,dimen/3
- dtmp(i)=0.0d0
- do j=1,dimen/3
- dtmp(i)=dtmp(i)+Ginv(i,j)*ztmp(j)
- enddo
- enddo
- do i=1,dimen/3
- ind=(i-1)*3+k+1
- d_a_tmp(ind)=dtmp(i)
- enddo
- enddo
- return
- end
-#endif
-c---------------------------------------------------------------------------
- SUBROUTINE fricmat_mult(z,d_a_tmp)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer IERROR
-#endif
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00
- &time01
-#ifdef MPI
- if (nfgtasks.gt.1) then
- if (fg_rank.eq.0) then
-c The matching BROADCAST for fg processors is called in ERGASTULUM
- time00=MPI_Wtime()
- call MPI_Bcast(9,1,MPI_INTEGER,king,FG_COMM,IERROR)
- time_Bcast=time_Bcast+MPI_Wtime()-time00
-c print *,"Processor",myrank," BROADCAST iorder in FRICMAT_MULT"
- endif
-c call MPI_Barrier(FG_COMM,IERROR)
- time00=MPI_Wtime()
- call MPI_Scatterv(z,ng_counts(0),ng_start(0),
- & MPI_DOUBLE_PRECISION,
- & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR)
-c write (2,*) "My chunk of z"
-c do i=1,3*my_ng_count
-c write (2,*) i,z(i)
-c enddo
- time_scatter=time_scatter+MPI_Wtime()-time00
-#ifdef TIMING
- time_scatter_fmatmult=time_scatter_fmatmult+MPI_Wtime()-time00
-#endif
- time01=MPI_Wtime()
- do k=0,2
- do i=1,dimen
- ind=(i-1)*3+k+1
- temp(ind)=0.0d0
- do j=1,my_ng_count
- temp(ind)=temp(ind)-fricmat(j,i)*z((j-1)*3+k+1)
- enddo
- enddo
- enddo
- time_fricmatmult=time_fricmatmult+MPI_Wtime()-time01
-c write (2,*) "Before REDUCE"
-c write (2,*) "d_a_tmp before reduce"
-c do i=1,dimen3
-c write (2,*) i,temp(i)
-c enddo
-c call flush(2)
- time00=MPI_Wtime()
- call MPI_Reduce(temp(1),d_a_tmp(1),dimen3,MPI_DOUBLE_PRECISION,
- & MPI_SUM,king,FG_COMM,IERR)
- time_reduce=time_reduce+MPI_Wtime()-time00
-c write (2,*) "After REDUCE"
-c call flush(2)
- else
-#endif
-#ifdef TIMING
- time01=MPI_Wtime()
-#endif
- do k=0,2
- do i=1,dimen
- ind=(i-1)*3+k+1
- d_a_tmp(ind)=0.0d0
- do j=1,dimen
- d_a_tmp(ind)=d_a_tmp(ind)
- & -fricmat(j,i)*z((j-1)*3+k+1)
- enddo
- enddo
- enddo
-#ifdef TIMING
- time_fricmatmult=time_fricmatmult+MPI_Wtime()-time01
-#endif
-#ifdef MPI
- endif
-#endif
-c write (iout,*) "Vector d_a"
-c do i=1,dimen3
-c write (2,*) i,d_a_tmp(i)
-c enddo
- return
- end
+++ /dev/null
-c-------------------------------------------------------------
-
- subroutine local_move_init(debug)
-crc implicit none
-
-c Includes
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS' ! Needed by COMMON.LOCAL
- include 'COMMON.GEO' ! For pi, deg2rad
- include 'COMMON.LOCAL' ! For vbl
- include 'COMMON.LOCMOVE'
-
-c INPUT arguments
- logical debug
-
-
-c Determine wheter to do some debugging output
- locmove_output=debug
-
-c Set the init_called flag to 1
- init_called=1
-
-c The following are never changed
- min_theta=60.D0*deg2rad ! (0,PI)
- max_theta=175.D0*deg2rad ! (0,PI)
- dmin2=vbl*vbl*2.*(1.-cos(min_theta))
- dmax2=vbl*vbl*2.*(1.-cos(max_theta))
- flag=1.0D300
- small=1.0D-5
- small2=0.5*small*small
-
-c Not really necessary...
- a_n=0
- b_n=0
- res_n=0
-
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine local_move(n_start, n_end, PHImin, PHImax)
-c Perform a local move between residues m and n (inclusive)
-c PHImin and PHImax [0,PI] determine the size of the move
-c Works on whatever structure is in the variables theta and phi,
-c sidechain variables are left untouched
-c The final structure is NOT minimized, but both the cartesian
-c variables c and the angles are up-to-date at the end (no further
-c chainbuild is required)
-crc implicit none
-
-c Includes
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.MINIM'
- include 'COMMON.SBRIDGE'
- include 'COMMON.LOCMOVE'
-
-c External functions
- integer move_res
- external move_res
- double precision ran_number
- external ran_number
-
-c INPUT arguments
- integer n_start, n_end ! First and last residues to move
- double precision PHImin, PHImax ! min/max angles [0,PI]
-
-c Local variables
- integer i,j
- double precision min,max
- integer iretcode
-
-
-c Check if local_move_init was called. This assumes that it
-c would not be 1 if not explicitely initialized
- if (init_called.ne.1) then
- write(6,*)' *** local_move_init not called!!!'
- stop
- endif
-
-c Quick check for crazy range
- if (n_start.gt.n_end .or. n_start.lt.1 .or. n_end.gt.nres) then
- write(6,'(a,i3,a,i3)')
- + ' *** Cannot make local move between n_start = ',
- + n_start,' and n_end = ',n_end
- return
- endif
-
-c Take care of end residues first...
- if (n_start.eq.1) then
-c Move residue 1 (completely random)
- theta(3)=ran_number(min_theta,max_theta)
- phi(4)=ran_number(-PI,PI)
- i=2
- else
- i=n_start
- endif
- if (n_end.eq.nres) then
-c Move residue nres (completely random)
- theta(nres)=ran_number(min_theta,max_theta)
- phi(nres)=ran_number(-PI,PI)
- j=nres-1
- else
- j=n_end
- endif
-
-c ...then go through all other residues one by one
-c Start from the two extremes and converge
- call chainbuild
- do while (i.le.j)
- min=PHImin
- max=PHImax
-c$$$c Move the first two residues by less than the others
-c$$$ if (i-n_start.lt.3) then
-c$$$ if (i-n_start.eq.0) then
-c$$$ min=0.4*PHImin
-c$$$ max=0.4*PHImax
-c$$$ else if (i-n_start.eq.1) then
-c$$$ min=0.8*PHImin
-c$$$ max=0.8*PHImax
-c$$$ else if (i-n_start.eq.2) then
-c$$$ min=PHImin
-c$$$ max=PHImax
-c$$$ endif
-c$$$ endif
-
-c The actual move, on residue i
- iretcode=move_res(min,max,i) ! Discard iretcode
- i=i+1
-
- if (i.le.j) then
- min=PHImin
- max=PHImax
-c$$$c Move the last two residues by less than the others
-c$$$ if (n_end-j.lt.3) then
-c$$$ if (n_end-j.eq.0) then
-c$$$ min=0.4*PHImin
-c$$$ max=0.4*PHImax
-c$$$ else if (n_end-j.eq.1) then
-c$$$ min=0.8*PHImin
-c$$$ max=0.8*PHImax
-c$$$ else if (n_end-j.eq.2) then
-c$$$ min=PHImin
-c$$$ max=PHImax
-c$$$ endif
-c$$$ endif
-
-c The actual move, on residue j
- iretcode=move_res(min,max,j) ! Discard iretcode
- j=j-1
- endif
- enddo
-
- call int_from_cart(.false.,.false.)
-
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine output_tabs
-c Prints out the contents of a_..., b_..., res_...
- implicit none
-
-c Includes
- include 'COMMON.GEO'
- include 'COMMON.LOCMOVE'
-
-c Local variables
- integer i,j
-
-
- write(6,*)'a_...'
- write(6,'(8f7.1)')(a_ang(i)*rad2deg,i=0,a_n-1)
- write(6,'(8(2x,3l1,2x))')((a_tab(i,j),i=0,2),j=0,a_n-1)
-
- write(6,*)'b_...'
- write(6,'(4f7.1)')(b_ang(i)*rad2deg,i=0,b_n-1)
- write(6,'(4(2x,3l1,2x))')((b_tab(i,j),i=0,2),j=0,b_n-1)
-
- write(6,*)'res_...'
- write(6,'(12f7.1)')(res_ang(i)*rad2deg,i=0,res_n-1)
- write(6,'(12(2x,3l1,2x))')((res_tab(0,i,j),i=0,2),j=0,res_n-1)
- write(6,'(12(2x,3l1,2x))')((res_tab(1,i,j),i=0,2),j=0,res_n-1)
- write(6,'(12(2x,3l1,2x))')((res_tab(2,i,j),i=0,2),j=0,res_n-1)
-
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine angles2tab(PHImin,PHImax,n,ang,tab)
-c Only uses angles if [0,PI] (but PHImin cannot be 0.,
-c and PHImax cannot be PI)
- implicit none
-
-c Includes
- include 'COMMON.GEO'
-
-c INPUT arguments
- double precision PHImin,PHImax
-
-c OUTPUT arguments
- integer n
- double precision ang(0:3)
- logical tab(0:2,0:3)
-
-
- if (PHImin .eq. PHImax) then
-c Special case with two 010's
- n = 2;
- ang(0) = -PHImin;
- ang(1) = PHImin;
- tab(0,0) = .false.
- tab(2,0) = .false.
- tab(0,1) = .false.
- tab(2,1) = .false.
- tab(1,0) = .true.
- tab(1,1) = .true.
- else if (PHImin .eq. PI) then
-c Special case with one 010
- n = 1
- ang(0) = PI
- tab(0,0) = .false.
- tab(2,0) = .false.
- tab(1,0) = .true.
- else if (PHImax .eq. 0.) then
-c Special case with one 010
- n = 1
- ang(0) = 0.
- tab(0,0) = .false.
- tab(2,0) = .false.
- tab(1,0) = .true.
- else
-c Standard cases
- n = 0
- if (PHImin .gt. 0.) then
-c Start of range (011)
- ang(n) = PHImin
- tab(0,n) = .false.
- tab(1,n) = .true.
- tab(2,n) = .true.
-c End of range (110)
- ang(n+1) = -PHImin
- tab(0,n+1) = .true.
- tab(1,n+1) = .true.
- tab(2,n+1) = .false.
- n = n+2
- endif
- if (PHImax .lt. PI) then
-c Start of range (011)
- ang(n) = -PHImax
- tab(0,n) = .false.
- tab(1,n) = .true.
- tab(2,n) = .true.
-c End of range (110)
- ang(n+1) = PHImax
- tab(0,n+1) = .true.
- tab(1,n+1) = .true.
- tab(2,n+1) = .false.
- n = n+2
- endif
- endif
-
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine minmax_angles(x,y,z,r,n,ang,tab)
-c When solutions do not exist, assume all angles
-c are acceptable - i.e., initial geometry must be correct
- implicit none
-
-c Includes
- include 'COMMON.GEO'
- include 'COMMON.LOCMOVE'
-
-c Input arguments
- double precision x,y,z,r
-
-c Output arguments
- integer n
- double precision ang(0:3)
- logical tab(0:2,0:3)
-
-c Local variables
- double precision num, denom, phi
- double precision Kmin, Kmax
- integer i
-
-
- num = x*x + y*y + z*z
- denom = x*x + y*y
- n = 0
- if (denom .gt. 0.) then
- phi = atan2(y,x)
- denom = 2.*r*sqrt(denom)
- num = num+r*r
- Kmin = (num - dmin2)/denom
- Kmax = (num - dmax2)/denom
-
-c Allowed values of K (else all angles are acceptable)
-c -1 <= Kmin < 1
-c -1 < Kmax <= 1
- if (Kmin .gt. 1. .or. abs(Kmin-1.) .lt. small2) then
- Kmin = -flag
- else if (Kmin .lt. -1. .or. abs(Kmin+1.) .lt. small2) then
- Kmin = PI
- else
- Kmin = acos(Kmin)
- endif
-
- if (Kmax .lt. -1. .or. abs(Kmax+1.) .lt. small2) then
- Kmax = flag
- else if (Kmax .gt. 1. .or. abs(Kmax-1.) .lt. small2) then
- Kmax = 0.
- else
- Kmax = acos(Kmax)
- endif
-
- if (Kmax .lt. Kmin) Kmax = Kmin
-
- call angles2tab(Kmin, Kmax, n, ang, tab)
-
-c Add phi and check that angles are within range (-PI,PI]
- do i=0,n-1
- ang(i) = ang(i)+phi
- if (ang(i) .le. -PI) then
- ang(i) = ang(i)+2.*PI
- else if (ang(i) .gt. PI) then
- ang(i) = ang(i)-2.*PI
- endif
- enddo
- endif
-
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine construct_tab
-c Take a_... and b_... values and produces the results res_...
-c x_ang are assumed to be all different (diff > small)
-c x_tab(1,i) must be 1 for all i (i.e., all x_ang are acceptable)
- implicit none
-
-c Includes
- include 'COMMON.LOCMOVE'
-
-c Local variables
- integer n_max,i,j,index
- logical done
- double precision phi
-
-
- n_max = a_n + b_n
- if (n_max .eq. 0) then
- res_n = 0
- return
- endif
-
- do i=0,n_max-1
- do j=0,1
- res_tab(j,0,i) = .true.
- res_tab(j,2,i) = .true.
- res_tab(j,1,i) = .false.
- enddo
- enddo
-
- index = 0
- phi = -flag
- done = .false.
- do while (.not.done)
- res_ang(index) = flag
-
-c Check a first...
- do i=0,a_n-1
- if ((a_ang(i)-phi).gt.small .and.
- + a_ang(i) .lt. res_ang(index)) then
-c Found a lower angle
- res_ang(index) = a_ang(i)
-c Copy the values from a_tab into res_tab(0,,)
- res_tab(0,0,index) = a_tab(0,i)
- res_tab(0,1,index) = a_tab(1,i)
- res_tab(0,2,index) = a_tab(2,i)
-c Set default values for res_tab(1,,)
- res_tab(1,0,index) = .true.
- res_tab(1,1,index) = .false.
- res_tab(1,2,index) = .true.
- else if (abs(a_ang(i)-res_ang(index)).lt.small) then
-c Found an equal angle (can only be equal to a b_ang)
- res_tab(0,0,index) = a_tab(0,i)
- res_tab(0,1,index) = a_tab(1,i)
- res_tab(0,2,index) = a_tab(2,i)
- endif
- enddo
-c ...then check b
- do i=0,b_n-1
- if ((b_ang(i)-phi).gt.small .and.
- + b_ang(i) .lt. res_ang(index)) then
-c Found a lower angle
- res_ang(index) = b_ang(i)
-c Copy the values from b_tab into res_tab(1,,)
- res_tab(1,0,index) = b_tab(0,i)
- res_tab(1,1,index) = b_tab(1,i)
- res_tab(1,2,index) = b_tab(2,i)
-c Set default values for res_tab(0,,)
- res_tab(0,0,index) = .true.
- res_tab(0,1,index) = .false.
- res_tab(0,2,index) = .true.
- else if (abs(b_ang(i)-res_ang(index)).lt.small) then
-c Found an equal angle (can only be equal to an a_ang)
- res_tab(1,0,index) = b_tab(0,i)
- res_tab(1,1,index) = b_tab(1,i)
- res_tab(1,2,index) = b_tab(2,i)
- endif
- enddo
-
- if (res_ang(index) .eq. flag) then
- res_n = index
- done = .true.
- else if (index .eq. n_max-1) then
- res_n = n_max
- done = .true.
- else
- phi = res_ang(index) ! Store previous angle
- index = index+1
- endif
- enddo
-
-c Fill the gaps
-c First a...
- index = 0
- if (a_n .gt. 0) then
- do while (.not.res_tab(0,1,index))
- index=index+1
- enddo
- done = res_tab(0,2,index)
- do i=index+1,res_n-1
- if (res_tab(0,1,i)) then
- done = res_tab(0,2,i)
- else
- res_tab(0,0,i) = done
- res_tab(0,1,i) = done
- res_tab(0,2,i) = done
- endif
- enddo
- done = res_tab(0,0,index)
- do i=index-1,0,-1
- if (res_tab(0,1,i)) then
- done = res_tab(0,0,i)
- else
- res_tab(0,0,i) = done
- res_tab(0,1,i) = done
- res_tab(0,2,i) = done
- endif
- enddo
- else
- do i=0,res_n-1
- res_tab(0,0,i) = .true.
- res_tab(0,1,i) = .true.
- res_tab(0,2,i) = .true.
- enddo
- endif
-c ...then b
- index = 0
- if (b_n .gt. 0) then
- do while (.not.res_tab(1,1,index))
- index=index+1
- enddo
- done = res_tab(1,2,index)
- do i=index+1,res_n-1
- if (res_tab(1,1,i)) then
- done = res_tab(1,2,i)
- else
- res_tab(1,0,i) = done
- res_tab(1,1,i) = done
- res_tab(1,2,i) = done
- endif
- enddo
- done = res_tab(1,0,index)
- do i=index-1,0,-1
- if (res_tab(1,1,i)) then
- done = res_tab(1,0,i)
- else
- res_tab(1,0,i) = done
- res_tab(1,1,i) = done
- res_tab(1,2,i) = done
- endif
- enddo
- else
- do i=0,res_n-1
- res_tab(1,0,i) = .true.
- res_tab(1,1,i) = .true.
- res_tab(1,2,i) = .true.
- enddo
- endif
-
-c Finally fill the last row with AND operation
- do i=0,res_n-1
- do j=0,2
- res_tab(2,j,i) = (res_tab(0,j,i) .and. res_tab(1,j,i))
- enddo
- enddo
-
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine construct_ranges(phi_n,phi_start,phi_end)
-c Given the data in res_..., construct a table of
-c min/max allowed angles
- implicit none
-
-c Includes
- include 'COMMON.GEO'
- include 'COMMON.LOCMOVE'
-
-c Output arguments
- integer phi_n
- double precision phi_start(0:11),phi_end(0:11)
-
-c Local variables
- logical done
- integer index
-
-
- if (res_n .eq. 0) then
-c Any move is allowed
- phi_n = 1
- phi_start(0) = -PI
- phi_end(0) = PI
- else
- phi_n = 0
- index = 0
- done = .false.
- do while (.not.done)
-c Find start of range (01x)
- done = .false.
- do while (.not.done)
- if (res_tab(2,0,index).or.(.not.res_tab(2,1,index))) then
- index=index+1
- else
- done = .true.
- phi_start(phi_n) = res_ang(index)
- endif
- if (index .eq. res_n) done = .true.
- enddo
-c If a start was found (index < res_n), find the end of range (x10)
-c It may not be found without wrapping around
- if (index .lt. res_n) then
- done = .false.
- do while (.not.done)
- if ((.not.res_tab(2,1,index)).or.res_tab(2,2,index)) then
- index=index+1
- else
- done = .true.
- endif
- if (index .eq. res_n) done = .true.
- enddo
- if (index .lt. res_n) then
-c Found the end of the range
- phi_end(phi_n) = res_ang(index)
- phi_n=phi_n+1
- index=index+1
- if (index .eq. res_n) then
- done = .true.
- else
- done = .false.
- endif
- else
-c Need to wrap around
- done = .true.
- phi_end(phi_n) = flag
- endif
- endif
- enddo
-c Take care of the last one if need to wrap around
- if (phi_end(phi_n) .eq. flag) then
- index = 0
- do while ((.not.res_tab(2,1,index)).or.res_tab(2,2,index))
- index=index+1
- enddo
- phi_end(phi_n) = res_ang(index) + 2.*PI
- phi_n=phi_n+1
- endif
- endif
-
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine fix_no_moves(phi)
- implicit none
-
-c Includes
- include 'COMMON.GEO'
- include 'COMMON.LOCMOVE'
-
-c Output arguments
- double precision phi
-
-c Local variables
- integer index
- double precision diff,temp
-
-
-c Look for first 01x in gammas (there MUST be at least one)
- diff = flag
- index = 0
- do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index)))
- index=index+1
- enddo
- if (res_ang(index) .le. 0.D0) then ! Make sure it's from PHImax
-c Try to increase PHImax
- if (index .gt. 0) then
- phi = res_ang(index-1)
- diff = abs(res_ang(index) - res_ang(index-1))
- endif
-c Look for last (corresponding) x10
- index = res_n - 1
- do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index))
- index=index-1
- enddo
- if (index .lt. res_n-1) then
- temp = abs(res_ang(index) - res_ang(index+1))
- if (temp .lt. diff) then
- phi = res_ang(index+1)
- diff = temp
- endif
- endif
- endif
-
-c If increasing PHImax didn't work, decreasing PHImin
-c will (with one exception)
-c Look for first x10 (there MUST be at least one)
- index = 0
- do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index))
- index=index+1
- enddo
- if (res_ang(index) .lt. 0.D0) then ! Make sure it's from PHImin
-c Try to decrease PHImin
- if (index .lt. res_n-1) then
- temp = abs(res_ang(index) - res_ang(index+1))
- if (res_ang(index+1) .le. 0.D0 .and. temp .lt. diff) then
- phi = res_ang(index+1)
- diff = temp
- endif
- endif
-c Look for last (corresponding) 01x
- index = res_n - 1
- do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index)))
- index=index-1
- enddo
- if (index .gt. 0) then
- temp = abs(res_ang(index) - res_ang(index-1))
- if (res_ang(index-1) .ge. 0.D0 .and. temp .lt. diff) then
- phi = res_ang(index-1)
- diff = temp
- endif
- endif
- endif
-
-c If it still didn't work, it must be PHImax == 0. or PHImin == PI
- if (diff .eq. flag) then
- index = 0
- if (res_tab(index,1,0) .or. (.not.res_tab(index,1,1)) .or.
- + res_tab(index,1,2)) index = res_n - 1
-c This MUST work at this point
- if (index .eq. 0) then
- phi = res_ang(1)
- else
- phi = res_ang(index - 1)
- endif
- endif
-
- return
- end
-
-c-------------------------------------------------------------
-
- integer function move_res(PHImin,PHImax,i_move)
-c Moves residue i_move (in array c), leaving everything else fixed
-c Starting geometry is not checked, it should be correct!
-c R(,i_move) is the only residue that will move, but must have
-c 1 < i_move < nres (i.e., cannot move ends)
-c Whether any output is done is controlled by locmove_output
-crc implicit none
-
-c Includes
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.LOCMOVE'
-
-c External functions
- double precision ran_number
- external ran_number
-
-c Input arguments
- double precision PHImin,PHImax
- integer i_move
-
-c RETURN VALUES:
-c 0: move successfull
-c 1: Dmin or Dmax had to be modified
-c 2: move failed - check your input geometry
-
-
-c Local variables
- double precision X(0:2),Y(0:2),Z(0:2),Orig(0:2)
- double precision P(0:2)
- logical no_moves,done
- integer index,i,j
- double precision phi,temp,radius
- double precision phi_start(0:11), phi_end(0:11)
- integer phi_n
-
-c Set up the coordinate system
- do i=0,2
- Orig(i)=0.5*(c(i+1,i_move-1)+c(i+1,i_move+1)) ! Position of origin
- enddo
-
- do i=0,2
- Z(i)=c(i+1,i_move+1)-c(i+1,i_move-1)
- enddo
- temp=sqrt(Z(0)*Z(0)+Z(1)*Z(1)+Z(2)*Z(2))
- do i=0,2
- Z(i)=Z(i)/temp
- enddo
-
- do i=0,2
- X(i)=c(i+1,i_move)-Orig(i)
- enddo
-c radius is the radius of the circle on which c(,i_move) can move
- radius=sqrt(X(0)*X(0)+X(1)*X(1)+X(2)*X(2))
- do i=0,2
- X(i)=X(i)/radius
- enddo
-
- Y(0)=Z(1)*X(2)-X(1)*Z(2)
- Y(1)=X(0)*Z(2)-Z(0)*X(2)
- Y(2)=Z(0)*X(1)-X(0)*Z(1)
-
-c Calculate min, max angles coming from dmin, dmax to c(,i_move-2)
- if (i_move.gt.2) then
- do i=0,2
- P(i)=c(i+1,i_move-2)-Orig(i)
- enddo
- call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2),
- + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2),
- + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2),
- + radius,a_n,a_ang,a_tab)
- else
- a_n=0
- endif
-
-c Calculate min, max angles coming from dmin, dmax to c(,i_move+2)
- if (i_move.lt.nres-2) then
- do i=0,2
- P(i)=c(i+1,i_move+2)-Orig(i)
- enddo
- call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2),
- + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2),
- + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2),
- + radius,b_n,b_ang,b_tab)
- else
- b_n=0
- endif
-
-c Construct the resulting table for alpha and beta
- call construct_tab()
-
- if (locmove_output) then
- print *,'ALPHAS & BETAS TABLE'
- call output_tabs()
- endif
-
-c Check that there is at least one possible move
- no_moves = .true.
- if (res_n .eq. 0) then
- no_moves = .false.
- else
- index = 0
- do while ((index .lt. res_n) .and. no_moves)
- if (res_tab(2,1,index)) no_moves = .false.
- index=index+1
- enddo
- endif
- if (no_moves) then
- if (locmove_output) print *,' *** Cannot move anywhere'
- move_res=2
- return
- endif
-
-c Transfer res_... into a_...
- a_n = 0
- do i=0,res_n-1
- if ( (res_tab(2,0,i).neqv.res_tab(2,1,i)) .or.
- + (res_tab(2,0,i).neqv.res_tab(2,2,i)) ) then
- a_ang(a_n) = res_ang(i)
- do j=0,2
- a_tab(j,a_n) = res_tab(2,j,i)
- enddo
- a_n=a_n+1
- endif
- enddo
-
-c Check that the PHI's are within [0,PI]
- if (PHImin .lt. 0. .or. abs(PHImin) .lt. small) PHImin = -flag
- if (PHImin .gt. PI .or. abs(PHImin-PI) .lt. small) PHImin = PI
- if (PHImax .gt. PI .or. abs(PHImax-PI) .lt. small) PHImax = flag
- if (PHImax .lt. 0. .or. abs(PHImax) .lt. small) PHImax = 0.
- if (PHImax .lt. PHImin) PHImax = PHImin
-c Calculate min and max angles coming from PHImin and PHImax,
-c and put them in b_...
- call angles2tab(PHImin, PHImax, b_n, b_ang, b_tab)
-c Construct the final table
- call construct_tab()
-
- if (locmove_output) then
- print *,'FINAL TABLE'
- call output_tabs()
- endif
-
-c Check that there is at least one possible move
- no_moves = .true.
- if (res_n .eq. 0) then
- no_moves = .false.
- else
- index = 0
- do while ((index .lt. res_n) .and. no_moves)
- if (res_tab(2,1,index)) no_moves = .false.
- index=index+1
- enddo
- endif
-
- if (no_moves) then
-c Take care of the case where no solution exists...
- call fix_no_moves(phi)
- if (locmove_output) then
- print *,' *** Had to modify PHImin or PHImax'
- print *,'phi: ',phi*rad2deg
- endif
- move_res=1
- else
-c ...or calculate the solution
-c Construct phi_start/phi_end arrays
- call construct_ranges(phi_n, phi_start, phi_end)
-c Choose random angle phi in allowed range(s)
- temp = 0.
- do i=0,phi_n-1
- temp = temp + phi_end(i) - phi_start(i)
- enddo
- phi = ran_number(phi_start(0),phi_start(0)+temp)
- index = 0
- done = .false.
- do while (.not.done)
- if (phi .lt. phi_end(index)) then
- done = .true.
- else
- index=index+1
- endif
- if (index .eq. phi_n) then
- done = .true.
- else if (.not.done) then
- phi = phi + phi_start(index) - phi_end(index-1)
- endif
- enddo
- if (index.eq.phi_n) phi=phi_end(phi_n-1) ! Fix numerical errors
- if (phi .gt. PI) phi = phi-2.*PI
-
- if (locmove_output) then
- print *,'ALLOWED RANGE(S)'
- do i=0,phi_n-1
- print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg
- enddo
- print *,'phi: ',phi*rad2deg
- endif
- move_res=0
- endif
-
-c Re-use radius as temp variable
- temp=radius*cos(phi)
- radius=radius*sin(phi)
- do i=0,2
- c(i+1,i_move)=Orig(i)+temp*X(i)+radius*Y(i)
- enddo
-
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine loc_test
-crc implicit none
-
-c Includes
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.LOCMOVE'
-
-c External functions
- integer move_res
- external move_res
-
-c Local variables
- integer i,j
- integer phi_n
- double precision phi_start(0:11),phi_end(0:11)
- double precision phi
- double precision R(0:2,0:5)
-
- locmove_output=.true.
-
-c call angles2tab(30.*deg2rad,70.*deg2rad,a_n,a_ang,a_tab)
-c call angles2tab(80.*deg2rad,130.*deg2rad,b_n,b_ang,b_tab)
-c call minmax_angles(0.D0,3.8D0,0.D0,3.8D0,b_n,b_ang,b_tab)
-c call construct_tab
-c call output_tabs
-
-c call construct_ranges(phi_n,phi_start,phi_end)
-c do i=0,phi_n-1
-c print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg
-c enddo
-
-c call fix_no_moves(phi)
-c print *,'NO MOVES FOUND, BEST PHI IS',phi*rad2deg
-
- R(0,0)=0.D0
- R(1,0)=0.D0
- R(2,0)=0.D0
- R(0,1)=0.D0
- R(1,1)=-cos(28.D0*deg2rad)
- R(2,1)=-0.5D0-sin(28.D0*deg2rad)
- R(0,2)=0.D0
- R(1,2)=0.D0
- R(2,2)=-0.5D0
- R(0,3)=cos(30.D0*deg2rad)
- R(1,3)=0.D0
- R(2,3)=0.D0
- R(0,4)=0.D0
- R(1,4)=0.D0
- R(2,4)=0.5D0
- R(0,5)=0.D0
- R(1,5)=cos(26.D0*deg2rad)
- R(2,5)=0.5D0+sin(26.D0*deg2rad)
- do i=1,5
- do j=0,2
- R(j,i)=vbl*R(j,i)
- enddo
- enddo
-c i=move_res(R(0,1),0.D0*deg2rad,180.D0*deg2rad)
- imov=nnt
- i=move_res(0.D0*deg2rad,180.D0*deg2rad,imov)
- print *,'RETURNED ',i
- print *,(R(i,3)/vbl,i=0,2)
-
- return
- end
-
-c-------------------------------------------------------------
+++ /dev/null
- subroutine map
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MAP'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.CONTROL'
- include 'COMMON.TORCNSTR'
- double precision energia(0:n_ene)
- character*5 angid(4) /'PHI','THETA','ALPHA','OMEGA'/
- double precision ang_list(10)
- double precision g(maxvar),x(maxvar)
- integer nn(10)
- write (iout,'(a,i3,a)')'Energy map constructed in the following ',
- & nmap,' groups of variables:'
- do i=1,nmap
- write (iout,'(2a,i3,a,i3)') angid(kang(i)),' of residues ',
- & res1(i),' to ',res2(i)
- enddo
- nmax=nstep(1)
- do i=2,nmap
- if (nmax.lt.nstep(i)) nmax=nstep(i)
- enddo
- ntot=nmax**nmap
- iii=0
- write (istat,'(1h#,a14,29a15)') (" ",k=1,nmap),
- & (ename(print_order(k)),k=1,nprint_ene),"ETOT","GNORM"
- do i=0,ntot-1
- ii=i
- do j=1,nmap
- nn(j)=mod(ii,nmax)+1
- ii=ii/nmax
- enddo
- do j=1,nmap
- if (nn(j).gt.nstep(j)) goto 10
- enddo
- iii=iii+1
-Cd write (iout,*) i,iii,(nn(j),j=1,nmap)
- do j=1,nmap
- ang_list(j)=ang_from(j)
- & +(nn(j)-1)*(ang_to(j)-ang_from(j))/nstep(j)
- do k=res1(j),res2(j)
- goto (1,2,3,4), kang(j)
- 1 phi(k)=deg2rad*ang_list(j)
- if (minim) phi0(k-res1(j)+1)=deg2rad*ang_list(j)
- goto 5
- 2 theta(k)=deg2rad*ang_list(j)
- goto 5
- 3 alph(k)=deg2rad*ang_list(j)
- goto 5
- 4 omeg(k)=deg2rad*ang_list(j)
- 5 continue
- enddo ! k
- enddo ! j
- call chainbuild
- call int_from_cart1(.false.)
- if (minim) then
- call geom_to_var(nvar,x)
- call minimize(etot,x,iretcode,nfun)
- print *,'SUMSL return code is',iretcode,' eval ',nfun
-c call intout
- else
- call zerograd
- call geom_to_var(nvar,x)
- endif
- call etotal(energia(0))
- etot = energia(0)
- nf=1
- nfl=3
- call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
- gnorm=0.0d0
- do k=1,nvar
- gnorm=gnorm+g(k)**2
- enddo
- etot=energia(0)
-
- gnorm=dsqrt(gnorm)
-c write (iout,'(6(1pe15.5))') (ang_list(k),k=1,nmap),etot,gnorm
- write (istat,'(30e15.5)') (ang_list(k),k=1,nmap),
- & (energia(print_order(ii)),ii=1,nprint_ene),etot,gnorm
-c write (iout,*) 'POINT',I,' ANGLES:',(ang_list(k),k=1,nmap)
-c call intout
-c call enerprint(energia)
- 10 continue
- enddo ! i
- return
- end
+++ /dev/null
- SUBROUTINE MATMULT(A1,A2,A3)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- DIMENSION A1(3,3),A2(3,3),A3(3,3)
- DIMENSION AI3(3,3)
- DO 1 I=1,3
- DO 2 J=1,3
- A3IJ=0.0
- DO 3 K=1,3
- 3 A3IJ=A3IJ+A1(I,K)*A2(K,J)
- AI3(I,J)=A3IJ
- 2 CONTINUE
- 1 CONTINUE
- DO 4 I=1,3
- DO 4 J=1,3
- 4 A3(I,J)=AI3(I,J)
- RETURN
- END
+++ /dev/null
- subroutine monte_carlo
-C Does Boltzmann and entropic sampling without energy minimization
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
-#ifdef MPL
- include 'COMMON.INFO'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.MCM'
- include 'COMMON.MCE'
- include 'COMMON.CONTACTS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.THREAD'
- include 'COMMON.NAMES'
- logical accepted,not_done,over,ovrtim,error,lprint
- integer MoveType,nbond,nbins
- integer conf_comp
- double precision RandOrPert
- double precision varia(maxvar),elowest,elowest1,
- & ehighest,ehighest1,eold
- double precision przes(3),obr(3,3)
- double precision varold(maxvar)
- logical non_conv
- integer moves1(-1:MaxMoveType+1,0:MaxProcs-1),
- & moves_acc1(-1:MaxMoveType+1,0:MaxProcs-1)
-#ifdef MPL
- double precision etot_temp,etot_all(0:MaxProcs)
- external d_vadd,d_vmin,d_vmax
- double precision entropy1(-max_ene:max_ene),
- & nhist1(-max_ene:max_ene)
- integer nbond_move1(maxres*(MaxProcs+1)),
- & nbond_acc1(maxres*(MaxProcs+1)),itemp(2)
-#endif
- double precision var_lowest(maxvar)
- double precision energia(0:n_ene),energia_ave(0:n_ene)
-C
- write(iout,'(a,i8,2x,a,f10.5)')
- & 'pool_read_freq=',pool_read_freq,' pool_fraction=',pool_fraction
- open (istat,file=statname)
- WhatsUp=0
- indminn=-max_ene
- indmaxx=max_ene
- facee=1.0D0/(maxacc*delte)
-C Number of bins in energy histogram
- nbins=e_up/delte-1
- write (iout,*) 'NBINS=',nbins
- conste=dlog(facee)
-C Read entropy from previous simulations.
- if (ent_read) then
- read (ientin,*) indminn,indmaxx,emin,emax
- print *,'indminn=',indminn,' indmaxx=',indmaxx,' emin=',emin,
- & ' emax=',emax
- do i=-max_ene,max_ene
- entropy(i)=0.0D0
- enddo
- read (ientin,*) (ijunk,ejunk,entropy(i),i=indminn,indmaxx)
- indmin=indminn
- indmax=indmaxx
- write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx,
- & ' emin=',emin,' emax=',emax
- write (iout,'(/a)') 'Initial entropy'
- do i=indminn,indmaxx
- write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i)
- enddo
- endif ! ent_read
-C Read the pool of conformations
- call read_pool
- elowest=1.0D+10
- ehighest=-1.0D+10
-C----------------------------------------------------------------------------
-C Entropy-sampling simulations with continually updated entropy;
-C set NSWEEP=1 for Boltzmann sampling.
-C Loop thru simulations
-C----------------------------------------------------------------------------
- DO ISWEEP=1,NSWEEP
-C
-C Initialize the IFINISH array.
-C
-#ifdef MPL
- do i=1,nctasks
- ifinish(i)=0
- enddo
-#endif
-c---------------------------------------------------------------------------
-C Initialize counters.
-c---------------------------------------------------------------------------
-C Total number of generated confs.
- ngen=0
-C Total number of moves. In general this won't be equal to the number of
-C attempted moves, because we may want to reject some "bad" confs just by
-C overlap check.
- nmove=0
-C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,...
-C motions.
- do i=1,nres
- nbond_move(i)=0
- nbond_acc(i)=0
- enddo
-C Initialize total and accepted number of moves of various kind.
- do i=-1,MaxMoveType
- moves(i)=0
- moves_acc(i)=0
- enddo
-C Total number of energy evaluations.
- neneval=0
- nfun=0
-C----------------------------------------------------------------------------
-C Take a conformation from the pool
-C----------------------------------------------------------------------------
- rewind(istat)
- write (iout,*) 'emin=',emin,' emax=',emax
- if (npool.gt.0) then
- ii=iran_num(1,npool)
- do i=1,nvar
- varia(i)=xpool(i,ii)
- enddo
- write (iout,*) 'Took conformation',ii,' from the pool energy=',
- & epool(ii)
- call var_to_geom(nvar,varia)
-C Print internal coordinates of the initial conformation
- call intout
- else if (isweep.gt.1) then
- if (eold.lt.emax) then
- do i=1,nvar
- varia(i)=varold(i)
- enddo
- else
- do i=1,nvar
- varia(i)=var_lowest(i)
- enddo
- endif
- call var_to_geom(nvar,varia)
- endif
-C----------------------------------------------------------------------------
-C Compute and print initial energies.
-C----------------------------------------------------------------------------
- nsave=0
- Kwita=0
- WhatsUp=0
- write (iout,'(/80(1h*)/a,i2/80(1h*)/)') 'MCE iteration #',isweep
- write (iout,'(/80(1h*)/a)') 'Initial energies:'
- call chainbuild
- call geom_to_var(nvar,varia)
- call etotal(energia(0))
- etot = energia(0)
- call enerprint(energia(0))
- if (refstr) then
- call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes,
- & obr,non_conv)
- rms=dsqrt(rms)
- call contact(.false.,ncont,icont,co)
- frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
- write (iout,'(a,f8.3,a,f8.3,a,f8.3)')
- & 'RMS deviation from the reference structure:',rms,
- & ' % of native contacts:',frac*100,' contact order',co
- write (istat,'(i10,16(1pe14.5))') 0,
- & (energia(print_order(i)),i=1,nprint_ene),
- & etot,rms,frac,co
- else
- write (istat,'(i10,14(1pe14.5))') 0,
- & (energia(print_order(i)),i=1,nprint_ene),etot
- endif
-c close(istat)
- neneval=neneval+1
- if (.not. ent_read) then
-C Initialize the entropy array
-#ifdef MPL
-C Collect total energies from other processors.
- etot_temp=etot
- etot_all(0)=etot
- call mp_gather(etot_temp,etot_all,8,MasterID,cgGroupID)
- if (MyID.eq.MasterID) then
-C Get the lowest and the highest energy.
- print *,'MASTER: etot_temp: ',(etot_all(i),i=0,nprocs-1),
- & ' emin=',emin,' emax=',emax
- emin=1.0D10
- emax=-1.0D10
- do i=0,nprocs
- if (emin.gt.etot_all(i)) emin=etot_all(i)
- if (emax.lt.etot_all(i)) emax=etot_all(i)
- enddo
- emax=emin+e_up
- endif ! MyID.eq.MasterID
- etot_all(1)=emin
- etot_all(2)=emax
- print *,'Processor',MyID,' calls MP_BCAST to send/recv etot_all'
- call mp_bcast(etot_all(1),16,MasterID,cgGroupID)
- print *,'Processor',MyID,' MP_BCAST to send/recv etot_all ended'
- if (MyID.ne.MasterID) then
- print *,'Processor:',MyID,etot_all(1),etot_all(2),
- & etot_all(1),etot_all(2)
- emin=etot_all(1)
- emax=etot_all(2)
- endif ! MyID.ne.MasterID
- write (iout,*) 'After MP_GATHER etot_temp=',
- & etot_temp,' emin=',emin
-#else
- emin=etot
- emax=emin+e_up
- indminn=0
- indmin=0
-#endif
- IF (MULTICAN) THEN
-C Multicanonical sampling - start from Boltzmann distribution
- do i=-max_ene,max_ene
- entropy(i)=(emin+i*delte)*betbol
- enddo
- ELSE
-C Entropic sampling - start from uniform distribution of the density of states
- do i=-max_ene,max_ene
- entropy(i)=0.0D0
- enddo
- ENDIF ! MULTICAN
- write (iout,'(/a)') 'Initial entropy'
- do i=indminn,indmaxx
- write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i)
- enddo
- if (isweep.eq.1) then
- emax=emin+e_up
- indminn=0
- indmin=0
- indmaxx=indminn+nbins
- indmax=indmaxx
- endif ! isweep.eq.1
- endif ! .not. ent_read
-#ifdef MPL
- call recv_stop_sig(Kwita)
- if (whatsup.eq.1) then
- call send_stop_sig(-2)
- not_done=.false.
- else if (whatsup.le.-2) then
- not_done=.false.
- else if (whatsup.eq.2) then
- not_done=.false.
- else
- not_done=.true.
- endif
-#else
- not_done=.true.
-#endif
- write (iout,'(/80(1h*)/20x,a/80(1h*))')
- & 'Enter Monte Carlo procedure.'
- close(igeom)
- call briefout(0,etot)
- do i=1,nvar
- varold(i)=varia(i)
- enddo
- eold=etot
- call entropia(eold,sold,indeold)
-C NACC is the counter for the accepted conformations of a given processor
- nacc=0
-C NACC_TOT counts the total number of accepted conformations
- nacc_tot=0
-C Main loop.
-c----------------------------------------------------------------------------
-C Zero out average energies
- do i=0,n_ene
- energia_ave(i)=0.0d0
- enddo
-C Initialize energy histogram
- do i=-max_ene,max_ene
- nhist(i)=0.0D0
- enddo ! i
-C Zero out iteration counter.
- it=0
- do j=1,nvar
- varold(j)=varia(j)
- enddo
-C Begin MC iteration loop.
- do while (not_done)
- it=it+1
-C Initialize local counter.
- ntrial=0 ! # of generated non-overlapping confs.
- noverlap=0 ! # of overlapping confs.
- accepted=.false.
- do while (.not. accepted .and. WhatsUp.eq.0 .and. Kwita.eq.0)
- ntrial=ntrial+1
-C Retrieve the angles of previously accepted conformation
- do j=1,nvar
- varia(j)=varold(j)
- enddo
- call var_to_geom(nvar,varia)
-C Rebuild the chain.
- call chainbuild
- MoveType=0
- nbond=0
- lprint=.true.
-C Decide whether to take a conformation from the pool or generate/perturb one
-C randomly
- from_pool=ran_number(0.0D0,1.0D0)
- if (npool.gt.0 .and. from_pool.lt.pool_fraction) then
-C Throw a dice to choose the conformation from the pool
- ii=iran_num(1,npool)
- do i=1,nvar
- varia(i)=xpool(i,ii)
- enddo
- call var_to_geom(nvar,varia)
- call chainbuild
-cd call intout
-cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar)
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it)
- & write (iout,'(a,i3,a,f10.5)')
- & 'Try conformation',ii,' from the pool energy=',epool(ii)
- MoveType=-1
- moves(-1)=moves(-1)+1
- else
-C Decide whether to generate a random conformation or perturb the old one
- RandOrPert=ran_number(0.0D0,1.0D0)
- if (RandOrPert.gt.RanFract) then
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it)
- & write (iout,'(a)') 'Perturbation-generated conformation.'
- call perturb(error,lprint,MoveType,nbond,0.1D0)
- if (error) goto 20
- if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then
- write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=',
- & MoveType,' returned from PERTURB.'
- goto 20
- endif
- call chainbuild
- else
- MoveType=0
- moves(0)=moves(0)+1
- nstart_grow=iran_num(3,nres)
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it)
- & write (iout,'(2a,i3)') 'Random-generated conformation',
- & ' - chain regrown from residue',nstart_grow
- call gen_rand_conf(nstart_grow,*30)
- endif
- call geom_to_var(nvar,varia)
- endif ! pool
-Cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar)
- ngen=ngen+1
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it)
- & write (iout,'(a,i5,a,i10,a,i10)')
- & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it)
- & write (*,'(a,i5,a,i10,a,i10)')
- & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen
- call etotal(energia(0))
- etot = energia(0)
- neneval=neneval+1
-cd call enerprint(energia(0))
-cd write(iout,*)'it=',it,' etot=',etot
- if (etot-elowest.gt.overlap_cut) then
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it)
- & write (iout,'(a,i5,a,1pe14.5)') 'Iteration',it,
- & ' Overlap detected in the current conf.; energy is',etot
- accepted=.false.
- noverlap=noverlap+1
- if (noverlap.gt.maxoverlap) then
- write (iout,'(a)') 'Too many overlapping confs.'
- goto 20
- endif
- else
-C--------------------------------------------------------------------------
-C... Acceptance test
-C--------------------------------------------------------------------------
- accepted=.false.
- if (WhatsUp.eq.0)
- & call accept_mc(it,etot,eold,scur,sold,varia,varold,accepted)
- if (accepted) then
- nacc=nacc+1
- nacc_tot=nacc_tot+1
- if (elowest.gt.etot) then
- elowest=etot
- do i=1,nvar
- var_lowest(i)=varia(i)
- enddo
- endif
- if (ehighest.lt.etot) ehighest=etot
- moves_acc(MoveType)=moves_acc(MoveType)+1
- if (MoveType.eq.1) then
- nbond_acc(nbond)=nbond_acc(nbond)+1
- endif
-C Compare with reference structure.
- if (refstr) then
- call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),
- & nsup,przes,obr,non_conv)
- rms=dsqrt(rms)
- call contact(.false.,ncont,icont,co)
- frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
- endif ! refstr
-C
-C Periodically save average energies and confs.
-C
- do i=0,n_ene
- energia_ave(i)=energia_ave(i)+energia(i)
- enddo
- moves(MaxMoveType+1)=nmove
- moves_acc(MaxMoveType+1)=nacc
- IF ((it/save_frequency)*save_frequency.eq.it) THEN
- do i=0,n_ene
- energia_ave(i)=energia_ave(i)/save_frequency
- enddo
- etot_ave=energia_ave(0)
-C#ifdef AIX
-C open (istat,file=statname,position='append')
-C#else
-C open (istat,file=statname,access='append')
-Cendif
- if (print_mc.gt.0)
- & write (iout,'(80(1h*)/20x,a,i20)')
- & 'Iteration #',it
- if (refstr .and. print_mc.gt.0) then
- write (iout,'(a,f8.3,a,f8.3,a,f8.3)')
- & 'RMS deviation from the reference structure:',rms,
- & ' % of native contacts:',frac*100,' contact order:',co
- endif
- if (print_stat) then
- if (refstr) then
- write (istat,'(i10,10(1pe14.5))') it,
- & (energia_ave(print_order(i)),i=1,nprint_ene),
- & etot_ave,rms_ave,frac_ave
- else
- write (istat,'(i10,10(1pe14.5))') it,
- & (energia_ave(print_order(i)),i=1,nprint_ene),
- & etot_ave
- endif
- endif
-c close(istat)
- if (print_mc.gt.0)
- & call statprint(nacc,nfun,iretcode,etot,elowest)
-C Print internal coordinates.
- if (print_int) call briefout(nacc,etot)
- do i=0,n_ene
- energia_ave(i)=0.0d0
- enddo
- ENDIF ! ( (it/save_frequency)*save_frequency.eq.it)
-C Update histogram
- inde=icialosc((etot-emin)/delte)
- nhist(inde)=nhist(inde)+1.0D0
-#ifdef MPL
- if ( (it/message_frequency)*message_frequency.eq.it
- & .and. (MyID.ne.MasterID) ) then
- call recv_stop_sig(Kwita)
- call send_MCM_info(message_frequency)
- endif
-#endif
-C Store the accepted conf. and its energy.
- eold=etot
- sold=scur
- do i=1,nvar
- varold(i)=varia(i)
- enddo
-#ifdef MPL
- if (Kwita.eq.0) call recv_stop_sig(kwita)
-#endif
- endif ! accepted
- endif ! overlap
-#ifdef MPL
- if (MyID.eq.MasterID .and.
- & (it/message_frequency)*message_frequency.eq.it) then
- call receive_MC_info
- if (nacc_tot.ge.maxacc) accepted=.true.
- endif
-#endif
-C if ((ntrial.gt.maxtrial_iter
-C & .or. (it/pool_read_freq)*pool_read_freq.eq.it)
-C & .and. npool.gt.0) then
-C Take a conformation from the pool
-C ii=iran_num(1,npool)
-C do i=1,nvar
-C varold(i)=xpool(i,ii)
-C enddo
-C if (ntrial.gt.maxtrial_iter)
-C & write (iout,*) 'Iteration',it,' max. # of trials exceeded.'
-C write (iout,*)
-C & 'Take conformation',ii,' from the pool energy=',epool(ii)
-C if (print_mc.gt.2)
-C & write (iout,'(10f8.3)') (rad2deg*varold(i),i=1,nvar)
-C ntrial=0
-C eold=epool(ii)
-C call entropia(eold,sold,indeold)
-C accepted=.true.
-C endif ! (ntrial.gt.maxtrial_iter .and. npool.gt.0)
- 30 continue
- enddo ! accepted
-#ifdef MPL
- if (MyID.eq.MasterID .and.
- & (it/message_frequency)*message_frequency.eq.it) then
- call receive_MC_info
- endif
- if (Kwita.eq.0) call recv_stop_sig(kwita)
-#endif
- if (ovrtim()) WhatsUp=-1
-cd write (iout,*) 'WhatsUp=',WhatsUp,' Kwita=',Kwita
- not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0)
- & .and. (Kwita.eq.0)
-cd write (iout,*) 'not_done=',not_done
-#ifdef MPL
- if (Kwita.lt.0) then
- print *,'Processor',MyID,
- & ' has received STOP signal =',Kwita,' in EntSamp.'
-cd print *,'not_done=',not_done
- if (Kwita.lt.-1) WhatsUp=Kwita
- if (MyID.ne.MasterID) call send_MCM_info(-1)
- else if (nacc_tot.ge.maxacc) then
- print *,'Processor',MyID,' calls send_stop_sig,',
- & ' because a sufficient # of confs. have been collected.'
-cd print *,'not_done=',not_done
- call send_stop_sig(-1)
- if (MyID.ne.MasterID) call send_MCM_info(-1)
- else if (WhatsUp.eq.-1) then
- print *,'Processor',MyID,
- & ' calls send_stop_sig because of timeout.'
-cd print *,'not_done=',not_done
- call send_stop_sig(-2)
- if (MyID.ne.MasterID) call send_MCM_info(-1)
- endif
-#endif
- enddo ! not_done
-
-C-----------------------------------------------------------------
-C... Construct energy histogram & update entropy
-C-----------------------------------------------------------------
- go to 21
- 20 WhatsUp=-3
-#ifdef MPL
- write (iout,*) 'Processor',MyID,
- & ' is broadcasting ERROR-STOP signal.'
- write (*,*) 'Processor',MyID,
- & ' is broadcasting ERROR-STOP signal.'
- call send_stop_sig(-3)
- if (MyID.ne.MasterID) call send_MCM_info(-1)
-#endif
- 21 continue
- write (iout,'(/a)') 'Energy histogram'
- do i=-100,100
- write (iout,'(i5,2f20.5)') i,emin+i*delte,nhist(i)
- enddo
-#ifdef MPL
-C Wait until every processor has sent complete MC info.
- if (MyID.eq.MasterID) then
- not_done=.true.
- do while (not_done)
-C write (*,*) 'The IFINISH array:'
-C write (*,*) (ifinish(i),i=1,nctasks)
- not_done=.false.
- do i=2,nctasks
- not_done=not_done.or.(ifinish(i).ge.0)
- enddo
- if (not_done) call receive_MC_info
- enddo
- endif
-C Make collective histogram from the work of all processors.
- msglen=(2*max_ene+1)*8
- print *,
- & 'Processor',MyID,' calls MP_REDUCE to send/receive histograms',
- & ' msglen=',msglen
- call mp_reduce(nhist,nhist1,msglen,MasterID,d_vadd,
- & cgGroupID)
- print *,'Processor',MyID,' MP_REDUCE accomplished for histogr.'
- do i=-max_ene,max_ene
- nhist(i)=nhist1(i)
- enddo
-C Collect min. and max. energy
- print *,
- &'Processor',MyID,' calls MP_REDUCE to send/receive energy borders'
- call mp_reduce(elowest,elowest1,8,MasterID,d_vmin,cgGroupID)
- call mp_reduce(ehighest,ehighest1,8,MasterID,d_vmax,cgGroupID)
- print *,'Processor',MyID,' MP_REDUCE accomplished for energies.'
- IF (MyID.eq.MasterID) THEN
- elowest=elowest1
- ehighest=ehighest1
-#endif
- write (iout,'(a,i10)') '# of accepted confs:',nacc_tot
- write (iout,'(a,f10.5,a,f10.5)') 'Lowest energy:',elowest,
- & ' Highest energy',ehighest
- indmin=icialosc((elowest-emin)/delte)
- imdmax=icialosc((ehighest-emin)/delte)
- if (indmin.lt.indminn) then
- emax=emin+indmin*delte+e_up
- indmaxx=indmin+nbins
- indminn=indmin
- endif
- if (.not.ent_read) ent_read=.true.
- write(iout,*)'indminn=',indminn,' indmaxx=',indmaxx
-C Update entropy (density of states)
- do i=indmin,indmax
- if (nhist(i).gt.0) then
- entropy(i)=entropy(i)+dlog(nhist(i)+0.0D0)
- endif
- enddo
- write (iout,'(/80(1h*)/a,i2/80(1h*)/)')
- & 'End of macroiteration',isweep
- write (iout,'(a,f10.5,a,f10.5)') 'Elowest=',elowest,
- & ' Ehighest=',ehighest
- write (iout,'(/a)') 'Energy histogram'
- do i=indminn,indmaxx
- write (iout,'(i5,2f20.5)') i,emin+i*delte,nhist(i)
- enddo
- write (iout,'(/a)') 'Entropy'
- do i=indminn,indmaxx
- write (iout,'(i5,2f20.5)') i,emin+i*delte,entropy(i)
- enddo
-C-----------------------------------------------------------------
-C... End of energy histogram construction
-C-----------------------------------------------------------------
-#ifdef MPL
- ELSE
- if (.not. ent_read) ent_read=.true.
- ENDIF ! MyID .eq. MaterID
- if (MyID.eq.MasterID) then
- itemp(1)=indminn
- itemp(2)=indmaxx
- endif
- print *,'before mp_bcast processor',MyID,' indminn=',indminn,
- & ' indmaxx=',indmaxx,' itemp=',itemp(1),itemp(2)
- call mp_bcast(itemp(1),8,MasterID,cgGroupID)
- call mp_bcast(emax,8,MasterID,cgGroupID)
- print *,'after mp_bcast processor',MyID,' indminn=',indminn,
- & ' indmaxx=',indmaxx,' itemp=',itemp(1),itemp(2)
- if (MyID .ne. MasterID) then
- indminn=itemp(1)
- indmaxx=itemp(2)
- endif
- msglen=(indmaxx-indminn+1)*8
- print *,'processor',MyID,' calling mp_bcast msglen=',msglen,
- & ' indminn=',indminn,' indmaxx=',indmaxx,' isweep=',isweep
- call mp_bcast(entropy(indminn),msglen,MasterID,cgGroupID)
- IF(MyID.eq.MasterID .and. .not. ovrtim() .and. WhatsUp.ge.0)THEN
- open (ientout,file=entname,status='unknown')
- write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax
- do i=indminn,indmaxx
- write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i)
- enddo
- close(ientout)
- ELSE
- write (iout,*) 'Received from master:'
- write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx,
- & ' emin=',emin,' emax=',emax
- write (iout,'(/a)') 'Entropy'
- do i=indminn,indmaxx
- write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i)
- enddo
- ENDIF ! MyID.eq.MasterID
- print *,'Processor',MyID,' calls MP_GATHER'
- call mp_gather(nbond_move,nbond_move1,4*Nbm,MasterID,
- & cgGroupID)
- call mp_gather(nbond_acc,nbond_acc1,4*Nbm,MasterID,
- & cgGroupID)
- print *,'Processor',MyID,' MP_GATHER call accomplished'
- if (MyID.eq.MasterID) then
-
- write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:'
- call statprint(nacc_tot,nfun,iretcode,etot,elowest)
- write (iout,'(a)')
- & 'Statistics of multiple-bond motions. Total motions:'
- write (iout,'(8i10)') (nbond_move(i),i=1,Nbm)
- write (iout,'(a)') 'Accepted motions:'
- write (iout,'(8i10)') (nbond_acc(i),i=1,Nbm)
-
- write (iout,'(a)')
- & 'Statistics of multi-bond moves of respective processors:'
- do iproc=1,Nprocs-1
- do i=1,Nbm
- ind=iproc*nbm+i
- nbond_move(i)=nbond_move(i)+nbond_move1(ind)
- nbond_acc(i)=nbond_acc(i)+nbond_acc1(ind)
- enddo
- enddo
- do iproc=0,NProcs-1
- write (iout,*) 'Processor',iproc,' nbond_move:',
- & (nbond_move1(iproc*nbm+i),i=1,Nbm),
- & ' nbond_acc:',(nbond_acc1(iproc*nbm+i),i=1,Nbm)
- enddo
- endif
- call mp_gather(moves,moves1,4*(MaxMoveType+3),MasterID,
- & cgGroupID)
- call mp_gather(moves_acc,moves_acc1,4*(MaxMoveType+3),
- & MasterID,cgGroupID)
- if (MyID.eq.MasterID) then
- do iproc=1,Nprocs-1
- do i=-1,MaxMoveType+1
- moves(i)=moves(i)+moves1(i,iproc)
- moves_acc(i)=moves_acc(i)+moves_acc1(i,iproc)
- enddo
- enddo
- nmove=0
- do i=0,MaxMoveType+1
- nmove=nmove+moves(i)
- enddo
- do iproc=0,NProcs-1
- write (iout,*) 'Processor',iproc,' moves',
- & (moves1(i,iproc),i=0,MaxMoveType+1),
- & ' moves_acc:',(moves_acc1(i,iproc),i=0,MaxMoveType+1)
- enddo
- endif
-#else
- open (ientout,file=entname,status='unknown')
- write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax
- do i=indminn,indmaxx
- write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i)
- enddo
- close(ientout)
-#endif
- write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:'
- call statprint(nacc_tot,nfun,iretcode,etot,elowest)
- write (iout,'(a)')
- & 'Statistics of multiple-bond motions. Total motions:'
- write (iout,'(8i10)') (nbond_move(i),i=1,Nbm)
- write (iout,'(a)') 'Accepted motions:'
- write (iout,'(8i10)') (nbond_acc(i),i=1,Nbm)
- if (ovrtim() .or. WhatsUp.lt.0) return
-
-C---------------------------------------------------------------------------
- ENDDO ! ISWEEP
-C---------------------------------------------------------------------------
-
- runtime=tcpu()
-
- if (isweep.eq.nsweep .and. it.ge.maxacc)
- &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.'
- return
- end
-c------------------------------------------------------------------------------
- subroutine accept_mc(it,ecur,eold,scur,sold,x,xold,accepted)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.MCE'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
-#ifdef MPL
- include 'COMMON.INFO'
-#endif
- include 'COMMON.GEO'
- double precision ecur,eold,xx,ran_number,bol
- double precision x(maxvar),xold(maxvar)
- logical accepted
-C Check if the conformation is similar.
-cd write (iout,*) 'Enter ACCEPTING'
-cd write (iout,*) 'Old PHI angles:'
-cd write (iout,*) (rad2deg*xold(i),i=1,nphi)
-cd write (iout,*) 'Current angles'
-cd write (iout,*) (rad2deg*x(i),i=1,nphi)
-cd ddif=dif_ang(nphi,x,xold)
-cd write (iout,*) 'Angle norm:',ddif
-cd write (iout,*) 'ecur=',ecur,' emax=',emax
- if (ecur.gt.emax) then
- accepted=.false.
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it)
- & write (iout,'(a)') 'Conformation rejected as too high in energy'
- return
- endif
-C Else evaluate the entropy of the conf and compare it with that of the previous
-C one.
- call entropia(ecur,scur,indecur)
-cd print *,'Processor',MyID,' ecur=',ecur,' indecur=',indecur,
-cd & ' scur=',scur,' eold=',eold,' sold=',sold
-cd print *,'deix=',deix,' dent=',dent,' delte=',delte
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) then
- write(iout,*)'it=',it,'ecur=',ecur,' indecur=',indecur,
- & ' scur=',scur
- write(iout,*)'eold=',eold,' sold=',sold
- endif
- if (scur.le.sold) then
- accepted=.true.
- else
-C Else carry out acceptance test
- xx=ran_number(0.0D0,1.0D0)
- xxh=scur-sold
- if (xxh.gt.50.0D0) then
- bol=0.0D0
- else
- bol=exp(-xxh)
- endif
- if (bol.gt.xx) then
- accepted=.true.
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it)
- & write (iout,'(a)') 'Conformation accepted.'
- else
- accepted=.false.
- if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it)
- & write (iout,'(a)') 'Conformation rejected.'
- endif
- endif
- return
- end
-c--------------------------------------------------------------------------
- integer function icialosc(x)
- double precision x
- if (x.lt.0.0D0) then
- icialosc=dint(x)-1
- else
- icialosc=dint(x)
- endif
- return
- end
-c--------------------------------------------------------------------------
- subroutine entropia(ecur,scur,indecur)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.MCE'
- include 'COMMON.IOUNITS'
- double precision ecur,scur
- integer indecur
- indecur=icialosc((ecur-emin)/delte)
- if (iabs(indecur).gt.max_ene) then
- if ((it/print_freq)*it.eq.it) write (iout,'(a,2i5)')
- & 'Accepting: Index out of range:',indecur
- scur=1000.0D0
- else if (indecur.ge.indmaxx) then
- scur=entropy(indecur)
- if (print_mc.gt.0 .and. (it/print_freq)*it.eq.it)
- & write (iout,*)'Energy boundary reached',
- & indmaxx,indecur,entropy(indecur)
- else
- deix=ecur-(emin+indecur*delte)
- dent=entropy(indecur+1)-entropy(indecur)
- scur=entropy(indecur)+(dent/delte)*deix
- endif
- return
- end
+++ /dev/null
- subroutine mcm_setup
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.MCM'
- include 'COMMON.CONTROL'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
-C
-C Set up variables used in MC/MCM.
-C
- write (iout,'(80(1h*)/20x,a/80(1h*))') 'MCM control parameters:'
- write (iout,'(5(a,i7))') 'Maxacc:',maxacc,' MaxTrial:',MaxTrial,
- & ' MaxRepm:',MaxRepm,' MaxGen:',MaxGen,' MaxOverlap:',MaxOverlap
- write (iout,'(4(a,f8.1)/2(a,i3))')
- & 'Tmin:',Tmin,' Tmax:',Tmax,' TstepH:',TstepH,
- & ' TstepC:',TstepC,'NstepH:',NstepH,' NstepC:',NstepC
- if (nwindow.gt.0) then
- write (iout,'(a)') 'Perturbation windows:'
- do i=1,nwindow
- i1=winstart(i)
- i2=winend(i)
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(a,i3,a,i3,a,i3)') restyp(it1),i1,restyp(it2),i2,
- & ' length',winlen(i)
- enddo
- endif
-C Rbolt=8.3143D-3*2.388459D-01 kcal/(mol*K)
- RBol=1.9858D-3
-C Number of "end bonds".
- koniecl=0
-c koniecl=nphi
- print *,'koniecl=',koniecl
- write (iout,'(a)') 'Probabilities of move types:'
- write (*,'(a)') 'Probabilities of move types:'
- do i=1,MaxMoveType
- write (iout,'(a,f10.5)') MovTypID(i),
- & sumpro_type(i)-sumpro_type(i-1)
- write (*,'(a,f10.5)') MovTypID(i),
- & sumpro_type(i)-sumpro_type(i-1)
- enddo
- write (iout,*)
-C Maximum length of N-bond segment to be moved
-c nbm=nres-1-(2*koniecl-1)
- if (nwindow.gt.0) then
- maxwinlen=winlen(1)
- do i=2,nwindow
- if (winlen(i).gt.maxwinlen) maxwinlen=winlen(i)
- enddo
- nbm=min0(maxwinlen,6)
- write (iout,'(a,i3,a,i3)') 'Nbm=',Nbm,' Maxwinlen=',Maxwinlen
- else
- nbm=min0(6,nres-2)
- endif
- sumpro_bond(0)=0.0D0
- sumpro_bond(1)=0.0D0
- do i=2,nbm
- sumpro_bond(i)=sumpro_bond(i-1)+1.0D0/dfloat(i)
- enddo
- write (iout,'(a)') 'The SumPro_Bond array:'
- write (iout,'(8f10.5)') (sumpro_bond(i),i=1,nbm)
- write (*,'(a)') 'The SumPro_Bond array:'
- write (*,'(8f10.5)') (sumpro_bond(i),i=1,nbm)
-C Maximum number of side chains moved simultaneously
-c print *,'nnt=',nnt,' nct=',nct
- ngly=0
- do i=nnt,nct
- if (itype(i).eq.10) ngly=ngly+1
- enddo
- mmm=nct-nnt-ngly+1
- if (mmm.gt.0) then
- MaxSideMove=min0((nct-nnt+1)/2,mmm)
- endif
-c print *,'MaxSideMove=',MaxSideMove
-C Max. number of generated confs (not used at present).
- maxgen=10000
-C Set initial temperature
- Tcur=Tmin
- betbol=1.0D0/(Rbol*Tcur)
- write (iout,'(a,f8.1,a,f10.5)') 'Initial temperature:',Tcur,
- & ' BetBol:',betbol
- write (iout,*) 'RanFract=',ranfract
- return
- end
-c------------------------------------------------------------------------------
-#ifndef MPI
- subroutine do_mcm(i_orig)
-C Monte-Carlo-with-Minimization calculations - serial code.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.MCM'
- include 'COMMON.CONTACTS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.CACHE'
-crc include 'COMMON.DEFORM'
-crc include 'COMMON.DEFORM1'
- include 'COMMON.NAMES'
- logical accepted,over,ovrtim,error,lprint,not_done,my_conf,
- & enelower,non_conv
- integer MoveType,nbond,conf_comp
- integer ifeed(max_cache)
- double precision varia(maxvar),varold(maxvar),elowest,eold,
- & przes(3),obr(3,3)
- double precision energia(0:n_ene)
- double precision coord1(maxres,3)
-
-C---------------------------------------------------------------------------
-C Initialize counters.
-C---------------------------------------------------------------------------
-C Total number of generated confs.
- ngen=0
-C Total number of moves. In general this won't be equal to the number of
-C attempted moves, because we may want to reject some "bad" confs just by
-C overlap check.
- nmove=0
-C Total number of temperature jumps.
- ntherm=0
-C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,...
-C motions.
- ncache=0
- do i=1,nres
- nbond_move(i)=0
- enddo
-C Initialize total and accepted number of moves of various kind.
- do i=0,MaxMoveType
- moves(i)=0
- moves_acc(i)=0
- enddo
-C Total number of energy evaluations.
- neneval=0
- nfun=0
- nsave=0
-
- write (iout,*) 'RanFract=',RanFract
-
- WhatsUp=0
- Kwita=0
-
-c----------------------------------------------------------------------------
-C Compute and print initial energies.
-c----------------------------------------------------------------------------
- call intout
- write (iout,'(/80(1h*)/a)') 'Initial energies:'
- call chainbuild
- nf=0
-
- call etotal(energia(0))
- etot = energia(0)
-C Minimize the energy of the first conformation.
- if (minim) then
- call geom_to_var(nvar,varia)
-! write (iout,*) 'The VARIA array'
-! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar)
- call minimize(etot,varia,iretcode,nfun)
- call var_to_geom(nvar,varia)
- call chainbuild
- write (iout,*) 'etot from MINIMIZE:',etot
-! write (iout,*) 'Tha VARIA array'
-! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar)
-
- call etotal(energia(0))
- etot=energia(0)
- call enerprint(energia(0))
- endif
- if (refstr) then
- call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes,
- & obr,non_conv)
- rms=dsqrt(rms)
- call contact(.false.,ncont,icont,co)
- frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
- write (iout,'(a,f8.3,a,f8.3,a,f8.3)')
- & 'RMS deviation from the reference structure:',rms,
- & ' % of native contacts:',frac*100,' contact order:',co
- if (print_stat)
- & write (istat,'(i5,17(1pe14.5))') 0,
- & (energia(print_order(i)),i=1,nprint_ene),
- & etot,rms,frac,co
- else
- if (print_stat) write (istat,'(i5,16(1pe14.5))') 0,
- & (energia(print_order(i)),i=1,nprint_ene),etot
- endif
- if (print_stat) close(istat)
- neneval=neneval+nfun+1
- write (iout,'(/80(1h*)/20x,a/80(1h*))')
- & 'Enter Monte Carlo procedure.'
- if (print_int) then
- close(igeom)
- call briefout(0,etot)
- endif
- eold=etot
- do i=1,nvar
- varold(i)=varia(i)
- enddo
- elowest=etot
- call zapis(varia,etot)
- nacc=0 ! total # of accepted confs of the current processor.
- nacc_tot=0 ! total # of accepted confs of all processors.
-
- not_done = (iretcode.ne.11)
-
-C----------------------------------------------------------------------------
-C Main loop.
-c----------------------------------------------------------------------------
- it=0
- nout=0
- do while (not_done)
- it=it+1
- write (iout,'(80(1h*)/20x,a,i7)')
- & 'Beginning iteration #',it
-C Initialize local counter.
- ntrial=0 ! # of generated non-overlapping confs.
- accepted=.false.
- do while (.not. accepted)
-
-C Retrieve the angles of previously accepted conformation
- noverlap=0 ! # of overlapping confs.
- do j=1,nvar
- varia(j)=varold(j)
- enddo
- call var_to_geom(nvar,varia)
-C Rebuild the chain.
- call chainbuild
-C Heat up the system, if necessary.
- call heat(over)
-C If temperature cannot be further increased, stop.
- if (over) goto 20
- MoveType=0
- nbond=0
- lprint=.true.
-cd write (iout,'(a)') 'Old variables:'
-cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar)
-C Decide whether to generate a random conformation or perturb the old one
- RandOrPert=ran_number(0.0D0,1.0D0)
- if (RandOrPert.gt.RanFract) then
- if (print_mc.gt.0)
- & write (iout,'(a)') 'Perturbation-generated conformation.'
- call perturb(error,lprint,MoveType,nbond,1.0D0)
- if (error) goto 20
- if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then
- write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=',
- & MoveType,' returned from PERTURB.'
- goto 20
- endif
- call chainbuild
- else
- MoveType=0
- moves(0)=moves(0)+1
- nstart_grow=iran_num(3,nres)
- if (print_mc.gt.0)
- & write (iout,'(2a,i3)') 'Random-generated conformation',
- & ' - chain regrown from residue',nstart_grow
- call gen_rand_conf(nstart_grow,*30)
- endif
- call geom_to_var(nvar,varia)
-cd write (iout,'(a)') 'New variables:'
-cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar)
- ngen=ngen+1
-
- call etotal(energia(0))
- etot=energia(0)
-c call enerprint(energia(0))
-c write (iout,'(2(a,1pe14.5))') 'Etot=',Etot,' Elowest=',Elowest
- if (etot-elowest.gt.overlap_cut) then
- if(iprint.gt.1.or.etot.lt.1d20)
- & write (iout,'(a,1pe14.5)')
- & 'Overlap detected in the current conf.; energy is',etot
- neneval=neneval+1
- accepted=.false.
- noverlap=noverlap+1
- if (noverlap.gt.maxoverlap) then
- write (iout,'(a)') 'Too many overlapping confs.'
- goto 20
- endif
- else
- if (minim) then
- call minimize(etot,varia,iretcode,nfun)
-cd write (iout,*) 'etot from MINIMIZE:',etot
-cd write (iout,'(a)') 'Variables after minimization:'
-cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar)
-
- call etotal(energia(0))
- etot = energia(0)
- neneval=neneval+nfun+2
- endif
-c call enerprint(energia(0))
- write (iout,'(a,i6,a,1pe16.6)') 'Conformation:',ngen,
- & ' energy:',etot
-C--------------------------------------------------------------------------
-C... Do Metropolis test
-C--------------------------------------------------------------------------
- accepted=.false.
- my_conf=.false.
-
- if (WhatsUp.eq.0 .and. Kwita.eq.0) then
- call metropolis(nvar,varia,varold,etot,eold,accepted,
- & my_conf,EneLower)
- endif
- write (iout,*) 'My_Conf=',My_Conf,' EneLower=',EneLower
- if (accepted) then
-
- nacc=nacc+1
- nacc_tot=nacc_tot+1
- if (elowest.gt.etot) elowest=etot
- moves_acc(MoveType)=moves_acc(MoveType)+1
- if (MoveType.eq.1) then
- nbond_acc(nbond)=nbond_acc(nbond)+1
- endif
-C Check against conformation repetitions.
- irepet=conf_comp(varia,etot)
- if (print_stat) then
-#if defined(AIX) || defined(PGI)
- open (istat,file=statname,position='append')
-#else
- open (istat,file=statname,access='append')
-#endif
- endif
- call statprint(nacc,nfun,iretcode,etot,elowest)
- if (refstr) then
- call var_to_geom(nvar,varia)
- call chainbuild
- call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),
- & nsup,przes,obr,non_conv)
- rms=dsqrt(rms)
- call contact(.false.,ncont,icont,co)
- frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
- write (iout,'(a,f8.3,a,f8.3)')
- & 'RMS deviation from the reference structure:',rms,
- & ' % of native contacts:',frac*100,' contact order',co
- endif ! refstr
- if (My_Conf) then
- nout=nout+1
- write (iout,*) 'Writing new conformation',nout
- if (refstr) then
- write (istat,'(i5,16(1pe14.5))') nout,
- & (energia(print_order(i)),i=1,nprint_ene),
- & etot,rms,frac
- else
- if (print_stat)
- & write (istat,'(i5,17(1pe14.5))') nout,
- & (energia(print_order(i)),i=1,nprint_ene),etot
- endif ! refstr
- if (print_stat) close(istat)
-C Print internal coordinates.
- if (print_int) call briefout(nout,etot)
-C Accumulate the newly accepted conf in the coord1 array, if it is different
-C from all confs that are already there.
- call compare_s1(n_thr,max_thread2,etot,varia,ii,
- & enetb1,coord1,rms_deform,.true.,iprint)
- write (iout,*) 'After compare_ss: n_thr=',n_thr
- if (ii.eq.1 .or. ii.eq.3) then
- write (iout,'(8f10.4)')
- & (rad2deg*coord1(i,n_thr),i=1,nvar)
- endif
- else
- write (iout,*) 'Conformation from cache, not written.'
- endif ! My_Conf
-
- if (nrepm.gt.maxrepm) then
- write (iout,'(a)') 'Too many conformation repetitions.'
- goto 20
- endif
-C Store the accepted conf. and its energy.
- eold=etot
- do i=1,nvar
- varold(i)=varia(i)
- enddo
- if (irepet.eq.0) call zapis(varia,etot)
-C Lower the temperature, if necessary.
- call cool
-
- else
-
- ntrial=ntrial+1
- endif ! accepted
- endif ! overlap
-
- 30 continue
- enddo ! accepted
-C Check for time limit.
- if (ovrtim()) WhatsUp=-1
- not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0)
- & .and. (Kwita.eq.0)
-
- enddo ! not_done
- goto 21
- 20 WhatsUp=-3
-
- 21 continue
- runtime=tcpu()
- write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:'
- call statprint(nacc,nfun,iretcode,etot,elowest)
- write (iout,'(a)')
- & 'Statistics of multiple-bond motions. Total motions:'
- write (iout,'(16i5)') (nbond_move(i),i=1,Nbm)
- write (iout,'(a)') 'Accepted motions:'
- write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm)
- if (it.ge.maxacc)
- &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.'
-
- return
- end
-#endif
-#ifdef MPI
-c------------------------------------------------------------------------------
- subroutine do_mcm(i_orig)
-C Monte-Carlo-with-Minimization calculations - parallel code.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.MCM'
- include 'COMMON.CONTACTS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.INFO'
- include 'COMMON.CACHE'
-crc include 'COMMON.DEFORM'
-crc include 'COMMON.DEFORM1'
-crc include 'COMMON.DEFORM2'
- include 'COMMON.MINIM'
- include 'COMMON.NAMES'
- logical accepted,over,ovrtim,error,lprint,not_done,similar,
- & enelower,non_conv,flag,finish
- integer MoveType,nbond,conf_comp
- double precision varia(maxvar),varold(maxvar),elowest,eold,
- & x1(maxvar), varold1(maxvar), przes(3),obr(3,3)
- integer iparentx(max_threadss2)
- integer iparentx1(max_threadss2)
- integer imtasks(150),imtasks_n
- double precision energia(0:n_ene)
-
- print *,'Master entered DO_MCM'
- nodenum = nprocs
-
- finish=.false.
- imtasks_n=0
- do i=1,nodenum-1
- imtasks(i)=0
- enddo
-C---------------------------------------------------------------------------
-C Initialize counters.
-C---------------------------------------------------------------------------
-C Total number of generated confs.
- ngen=0
-C Total number of moves. In general this won`t be equal to the number of
-C attempted moves, because we may want to reject some "bad" confs just by
-C overlap check.
- nmove=0
-C Total number of temperature jumps.
- ntherm=0
-C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,...
-C motions.
- ncache=0
- do i=1,nres
- nbond_move(i)=0
- enddo
-C Initialize total and accepted number of moves of various kind.
- do i=0,MaxMoveType
- moves(i)=0
- moves_acc(i)=0
- enddo
-C Total number of energy evaluations.
- neneval=0
- nfun=0
- nsave=0
-c write (iout,*) 'RanFract=',RanFract
- WhatsUp=0
- Kwita=0
-c----------------------------------------------------------------------------
-C Compute and print initial energies.
-c----------------------------------------------------------------------------
- call intout
- write (iout,'(/80(1h*)/a)') 'Initial energies:'
- call chainbuild
- nf=0
- call etotal(energia(0))
- etot = energia(0)
- call enerprint(energia(0))
-C Request energy computation from slave processors.
- call geom_to_var(nvar,varia)
-! write (iout,*) 'The VARIA array'
-! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar)
- call minimize(etot,varia,iretcode,nfun)
- call var_to_geom(nvar,varia)
- call chainbuild
- write (iout,*) 'etot from MINIMIZE:',etot
-! write (iout,*) 'Tha VARIA array'
-! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar)
- neneval=0
- eneglobal=1.0d99
- if (print_mc .gt. 0) write (iout,'(/80(1h*)/20x,a/80(1h*))')
- & 'Enter Monte Carlo procedure.'
- if (print_mc .gt. 0) write (iout,'(i5,1pe14.5)' ) i_orig,etot
- eold=etot
- do i=1,nvar
- varold(i)=varia(i)
- enddo
- elowest=etot
- call zapis(varia,etot)
-c diagnostics
- call var_to_geom(nvar,varia)
- call chainbuild
- call etotal(energia(0))
- if (print_mc.gt.0) write (iout,*) 'Initial energy:',etot
-c end diagnostics
- nacc=0 ! total # of accepted confs of the current processor.
- nacc_tot=0 ! total # of accepted confs of all processors.
- not_done=.true.
-C----------------------------------------------------------------------------
-C Main loop.
-c----------------------------------------------------------------------------
- it=0
- nout=0
- LOOP1:do while (not_done)
- it=it+1
- if (print_mc.gt.0) write (iout,'(80(1h*)/20x,a,i7)')
- & 'Beginning iteration #',it
-C Initialize local counter.
- ntrial=0 ! # of generated non-overlapping confs.
- noverlap=0 ! # of overlapping confs.
- accepted=.false.
- LOOP2:do while (.not. accepted)
-
- LOOP3:do while (imtasks_n.lt.nodenum-1.and..not.finish)
- do i=1,nodenum-1
- if(imtasks(i).eq.0) then
- is=i
- exit
- endif
- enddo
-C Retrieve the angles of previously accepted conformation
- do j=1,nvar
- varia(j)=varold(j)
- enddo
- call var_to_geom(nvar,varia)
-C Rebuild the chain.
- call chainbuild
-C Heat up the system, if necessary.
- call heat(over)
-C If temperature cannot be further increased, stop.
- if (over) then
- finish=.true.
- endif
- MoveType=0
- nbond=0
-c write (iout,'(a)') 'Old variables:'
-c write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar)
-C Decide whether to generate a random conformation or perturb the old one
- RandOrPert=ran_number(0.0D0,1.0D0)
- if (RandOrPert.gt.RanFract) then
- if (print_mc.gt.0)
- & write (iout,'(a)') 'Perturbation-generated conformation.'
- call perturb(error,lprint,MoveType,nbond,1.0D0)
-c print *,'after perturb',error,finish
- if (error) finish = .true.
- if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then
- write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=',
- & MoveType,' returned from PERTURB.'
- finish=.true.
- write (*,'(/a,i7,a/)') 'Error - unknown MoveType=',
- & MoveType,' returned from PERTURB.'
- endif
- call chainbuild
- else
- MoveType=0
- moves(0)=moves(0)+1
- nstart_grow=iran_num(3,nres)
- if (print_mc.gt.0)
- & write (iout,'(2a,i3)') 'Random-generated conformation',
- & ' - chain regrown from residue',nstart_grow
- call gen_rand_conf(nstart_grow,*30)
- endif
- call geom_to_var(nvar,varia)
- ngen=ngen+1
-c print *,'finish=',finish
- if (etot-elowest.gt.overlap_cut) then
- if (print_mc.gt.1) write (iout,'(a,1pe14.5)')
- & 'Overlap detected in the current conf.; energy is',etot
- if(iprint.gt.1.or.etot.lt.1d19) print *,
- & 'Overlap detected in the current conf.; energy is',etot
- neneval=neneval+1
- accepted=.false.
- noverlap=noverlap+1
- if (noverlap.gt.maxoverlap) then
- write (iout,*) 'Too many overlapping confs.',
- & ' etot, elowest, overlap_cut', etot, elowest, overlap_cut
- finish=.true.
- endif
- else if (.not. finish) then
-C Distribute tasks to processors
-c print *,'Master sending order'
- call MPI_SEND(12, 1, MPI_INTEGER, is, tag,
- & CG_COMM, ierr)
-c write (iout,*) '12: tag=',tag
-c print *,'Master sent order to processor',is
- call MPI_SEND(it, 1, MPI_INTEGER, is, tag,
- & CG_COMM, ierr)
-c write (iout,*) 'it: tag=',tag
- call MPI_SEND(eold, 1, MPI_DOUBLE_PRECISION, is, tag,
- & CG_COMM, ierr)
-c write (iout,*) 'eold: tag=',tag
- call MPI_SEND(varia(1), nvar, MPI_DOUBLE_PRECISION,
- & is, tag,
- & CG_COMM, ierr)
-c write (iout,*) 'varia: tag=',tag
- call MPI_SEND(varold(1), nvar, MPI_DOUBLE_PRECISION,
- & is, tag,
- & CG_COMM, ierr)
-c write (iout,*) 'varold: tag=',tag
-#ifdef AIX
- call flush_(iout)
-#else
- call flush(iout)
-#endif
- imtasks(is)=1
- imtasks_n=imtasks_n+1
-C End distribution
- endif ! overlap
- enddo LOOP3
-
- flag = .false.
- LOOP_RECV:do while(.not.flag)
- do is=1, nodenum-1
- call MPI_IPROBE(is,tag,CG_COMM,flag,status,ierr)
- if(flag) then
- call MPI_RECV(iitt, 1, MPI_INTEGER, is, tag,
- & CG_COMM, status, ierr)
- call MPI_RECV(eold1, 1, MPI_DOUBLE_PRECISION, is, tag,
- & CG_COMM, status, ierr)
- call MPI_RECV(etot, 1, MPI_DOUBLE_PRECISION, is, tag,
- & CG_COMM, status, ierr)
- call MPI_RECV(varia(1), nvar, MPI_DOUBLE_PRECISION,is,tag,
- & CG_COMM, status, ierr)
- call MPI_RECV(varold1(1), nvar, MPI_DOUBLE_PRECISION, is,
- & tag, CG_COMM, status, ierr)
- call MPI_RECV(ii_grnum_d, 1, MPI_INTEGER, is, tag,
- & CG_COMM, status, ierr)
- call MPI_RECV(ii_ennum_d, 1, MPI_INTEGER, is, tag,
- & CG_COMM, status, ierr)
- call MPI_RECV(ii_hesnum_d, 1, MPI_INTEGER, is, tag,
- & CG_COMM, status, ierr)
- i_grnum_d=i_grnum_d+ii_grnum_d
- i_ennum_d=i_ennum_d+ii_ennum_d
- neneval = neneval+ii_ennum_d
- i_hesnum_d=i_hesnum_d+ii_hesnum_d
- i_minimiz=i_minimiz+1
- imtasks(is)=0
- imtasks_n=imtasks_n-1
- exit
- endif
- enddo
- enddo LOOP_RECV
-
- if(print_mc.gt.0) write (iout,'(a,i6,a,i6,a,i6,a,1pe16.6)')
- & 'From Worker #',is,' iitt',iitt,
- & ' Conformation:',ngen,' energy:',etot
-C--------------------------------------------------------------------------
-C... Do Metropolis test
-C--------------------------------------------------------------------------
- call metropolis(nvar,varia,varold1,etot,eold1,accepted,
- & similar,EneLower)
- if(iitt.ne.it.and..not.similar) then
- call metropolis(nvar,varia,varold,etot,eold,accepted,
- & similar,EneLower)
- accepted=enelower
- endif
- if(etot.lt.eneglobal)eneglobal=etot
-c if(mod(it,100).eq.0)
- write(iout,*)'CHUJOJEB ',neneval,eneglobal
- if (accepted) then
-C Write the accepted conformation.
- nout=nout+1
- if (refstr) then
- call var_to_geom(nvar,varia)
- call chainbuild
- call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),
- & nsup,przes,obr,non_conv)
- rms=dsqrt(rms)
- call contact(.false.,ncont,icont,co)
- frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
- write (iout,'(a,f8.3,a,f8.3,a,f8.3)')
- & 'RMS deviation from the reference structure:',rms,
- & ' % of native contacts:',frac*100,' contact order:',co
- endif ! refstr
- if (print_mc.gt.0)
- & write (iout,*) 'Writing new conformation',nout
- if (print_stat) then
- call var_to_geom(nvar,varia)
-#if defined(AIX) || defined(PGI)
- open (istat,file=statname,position='append')
-#else
- open (istat,file=statname,access='append')
-#endif
- if (refstr) then
- write (istat,'(i5,16(1pe14.5))') nout,
- & (energia(print_order(i)),i=1,nprint_ene),
- & etot,rms,frac
- else
- write (istat,'(i5,16(1pe14.5))') nout,
- & (energia(print_order(i)),i=1,nprint_ene),etot
- endif ! refstr
- close(istat)
- endif ! print_stat
-C Print internal coordinates.
- if (print_int) call briefout(nout,etot)
- nacc=nacc+1
- nacc_tot=nacc_tot+1
- if (elowest.gt.etot) elowest=etot
- moves_acc(MoveType)=moves_acc(MoveType)+1
- if (MoveType.eq.1) then
- nbond_acc(nbond)=nbond_acc(nbond)+1
- endif
-C Check against conformation repetitions.
- irepet=conf_comp(varia,etot)
- if (nrepm.gt.maxrepm) then
- if (print_mc.gt.0)
- & write (iout,'(a)') 'Too many conformation repetitions.'
- finish=.true.
- endif
-C Store the accepted conf. and its energy.
- eold=etot
- do i=1,nvar
- varold(i)=varia(i)
- enddo
- if (irepet.eq.0) call zapis(varia,etot)
-C Lower the temperature, if necessary.
- call cool
- else
- ntrial=ntrial+1
- endif ! accepted
- 30 continue
- if(finish.and.imtasks_n.eq.0)exit LOOP2
- enddo LOOP2 ! accepted
-C Check for time limit.
- not_done = (it.lt.max_mcm_it) .and. (nacc_tot.lt.maxacc)
- if(.not.not_done .or. finish) then
- if(imtasks_n.gt.0) then
- not_done=.true.
- else
- not_done=.false.
- endif
- finish=.true.
- endif
- enddo LOOP1 ! not_done
- runtime=tcpu()
- if (print_mc.gt.0) then
- write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:'
- call statprint(nacc,nfun,iretcode,etot,elowest)
- write (iout,'(a)')
- & 'Statistics of multiple-bond motions. Total motions:'
- write (iout,'(16i5)') (nbond_move(i),i=1,Nbm)
- write (iout,'(a)') 'Accepted motions:'
- write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm)
- if (it.ge.maxacc)
- &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.'
- endif
-#ifdef AIX
- call flush_(iout)
-#else
- call flush(iout)
-#endif
- do is=1,nodenum-1
- call MPI_SEND(999, 1, MPI_INTEGER, is, tag,
- & CG_COMM, ierr)
- enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine execute_slave(nodeinfo,iprint)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'mpif.h'
- include 'COMMON.TIME1'
- include 'COMMON.IOUNITS'
-crc include 'COMMON.DEFORM'
-crc include 'COMMON.DEFORM1'
-crc include 'COMMON.DEFORM2'
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.INFO'
- include 'COMMON.MINIM'
- character*10 nodeinfo
- double precision x(maxvar),x1(maxvar)
- nodeinfo='chujwdupe'
-c print *,'Processor:',MyID,' Entering execute_slave'
- tag=0
-c call MPI_SEND(nodeinfo, 10, MPI_CHARACTER, 0, tag,
-c & CG_COMM, ierr)
-
-1001 call MPI_RECV(i_switch, 1, MPI_INTEGER, 0, tag,
- & CG_COMM, status, ierr)
-c write(iout,*)'12: tag=',tag
- if(iprint.ge.2)print *, MyID,' recv order ',i_switch
- if (i_switch.eq.12) then
- i_grnum_d=0
- i_ennum_d=0
- i_hesnum_d=0
- call MPI_RECV(iitt, 1, MPI_INTEGER, 0, tag,
- & CG_COMM, status, ierr)
-c write(iout,*)'12: tag=',tag
- call MPI_RECV(ener, 1, MPI_DOUBLE_PRECISION, 0, tag,
- & CG_COMM, status, ierr)
-c write(iout,*)'ener: tag=',tag
- call MPI_RECV(x(1), nvar, MPI_DOUBLE_PRECISION, 0, tag,
- & CG_COMM, status, ierr)
-c write(iout,*)'x: tag=',tag
- call MPI_RECV(x1(1), nvar, MPI_DOUBLE_PRECISION, 0, tag,
- & CG_COMM, status, ierr)
-c write(iout,*)'x1: tag=',tag
-#ifdef AIX
- call flush_(iout)
-#else
- call flush(iout)
-#endif
-c print *,'calling minimize'
- call minimize(energyx,x,iretcode,nfun)
- if(iprint.gt.0)
- & write(iout,100)'minimized energy = ',energyx,
- & ' # funeval:',nfun,' iret ',iretcode
- write(*,100)'minimized energy = ',energyx,
- & ' # funeval:',nfun,' iret ',iretcode
- 100 format(a20,f10.5,a12,i5,a6,i2)
- if(iretcode.eq.10) then
- do iminrep=2,3
- if(iprint.gt.1)
- & write(iout,*)' ... not converged - trying again ',iminrep
- call minimize(energyx,x,iretcode,nfun)
- if(iprint.gt.1)
- & write(iout,*)'minimized energy = ',energyx,
- & ' # funeval:',nfun,' iret ',iretcode
- if(iretcode.ne.10)go to 812
- enddo
- if(iretcode.eq.10) then
- if(iprint.gt.1)
- & write(iout,*)' ... not converged again - giving up'
- go to 812
- endif
- endif
-812 continue
-c print *,'Sending results'
- call MPI_SEND(iitt, 1, MPI_INTEGER, 0, tag,
- & CG_COMM, ierr)
- call MPI_SEND(ener, 1, MPI_DOUBLE_PRECISION, 0, tag,
- & CG_COMM, ierr)
- call MPI_SEND(energyx, 1, MPI_DOUBLE_PRECISION, 0, tag,
- & CG_COMM, ierr)
- call MPI_SEND(x(1), nvar, MPI_DOUBLE_PRECISION, 0, tag,
- & CG_COMM, ierr)
- call MPI_SEND(x1(1), nvar, MPI_DOUBLE_PRECISION, 0, tag,
- & CG_COMM, ierr)
- call MPI_SEND(i_grnum_d, 1, MPI_INTEGER, 0, tag,
- & CG_COMM, ierr)
- call MPI_SEND(nfun, 1, MPI_INTEGER, 0, tag,
- & CG_COMM, ierr)
- call MPI_SEND(i_hesnum_d, 1, MPI_INTEGER, 0, tag,
- & CG_COMM, ierr)
-c print *,'End sending'
- go to 1001
- endif
-
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine statprint(it,nfun,iretcode,etot,elowest)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- include 'COMMON.MCM'
- if (minim) then
- write (iout,
- & '(80(1h*)/a,i5,a,1pe14.5,a,1pe14.5/a,i3,a,i10,a,i5,a,i5)')
- & 'Finished iteration #',it,' energy is',etot,
- & ' lowest energy:',elowest,
- & 'SUMSL return code:',iretcode,
- & ' # of energy evaluations:',neneval,
- & '# of temperature jumps:',ntherm,
- & ' # of minima repetitions:',nrepm
- else
- write (iout,'(80(1h*)/a,i8,a,1pe14.5,a,1pe14.5)')
- & 'Finished iteration #',it,' energy is',etot,
- & ' lowest energy:',elowest
- endif
- write (iout,'(/4a)')
- & 'Kind of move ',' total',' accepted',
- & ' fraction'
- write (iout,'(58(1h-))')
- do i=-1,MaxMoveType
- if (moves(i).eq.0) then
- fr_mov_i=0.0d0
- else
- fr_mov_i=dfloat(moves_acc(i))/dfloat(moves(i))
- endif
- write(iout,'(a,2i15,f10.5)')MovTypID(i),moves(i),moves_acc(i),
- & fr_mov_i
- enddo
- write (iout,'(a,2i15,f10.5)') 'total ',nmove,nacc_tot,
- & dfloat(nacc_tot)/dfloat(nmove)
- write (iout,'(58(1h-))')
- write (iout,'(a,1pe12.4)') 'Elapsed time:',tcpu()
- return
- end
-c------------------------------------------------------------------------------
- subroutine heat(over)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.IOUNITS'
- logical over
-C Check if there`s a need to increase temperature.
- if (ntrial.gt.maxtrial) then
- if (NstepH.gt.0) then
- if (dabs(Tcur-TMax).lt.1.0D-7) then
- if (print_mc.gt.0)
- & write (iout,'(/80(1h*)/a,f8.3,a/80(1h*))')
- & 'Upper limit of temperature reached. Terminating.'
- over=.true.
- Tcur=Tmin
- else
- Tcur=Tcur*TstepH
- if (Tcur.gt.Tmax) Tcur=Tmax
- betbol=1.0D0/(Rbol*Tcur)
- if (print_mc.gt.0)
- & write (iout,'(/80(1h*)/a,f8.3,a,f10.5/80(1h*))')
- & 'System heated up to ',Tcur,' K; BetBol:',betbol
- ntherm=ntherm+1
- ntrial=0
- over=.false.
- endif
- else
- if (print_mc.gt.0)
- & write (iout,'(a)')
- & 'Maximum number of trials in a single MCM iteration exceeded.'
- over=.true.
- Tcur=Tmin
- endif
- else
- over=.false.
- endif
- return
- end
-c------------------------------------------------------------------------------
- subroutine cool
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.IOUNITS'
- if (nstepC.gt.0 .and. dabs(Tcur-Tmin).gt.1.0D-7) then
- Tcur=Tcur/TstepC
- if (Tcur.lt.Tmin) Tcur=Tmin
- betbol=1.0D0/(Rbol*Tcur)
- if (print_mc.gt.0)
- & write (iout,'(/80(1h*)/a,f8.3,a,f10.5/80(1h*))')
- & 'System cooled down up to ',Tcur,' K; BetBol:',betbol
- endif
- return
- end
-C---------------------------------------------------------------------------
- subroutine zapis(varia,etot)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MP
- include 'mpif.h'
- include 'COMMON.INFO'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.MCM'
- include 'COMMON.IOUNITS'
- integer itemp(maxsave)
- double precision varia(maxvar)
- logical lprint
- lprint=.false.
- if (lprint) then
- write (iout,'(a,i5,a,i5)') 'Enter ZAPIS NSave=',Nsave,
- & ' MaxSave=',MaxSave
- write (iout,'(a)') 'Current energy and conformation:'
- write (iout,'(1pe14.5)') etot
- write (iout,'(10f8.3)') (rad2deg*varia(i),i=1,nvar)
- endif
-C Shift the contents of the esave and varsave arrays if filled up.
- call add2cache(maxvar,maxsave,nsave,nvar,MyID,itemp,
- & etot,varia,esave,varsave)
- if (lprint) then
- write (iout,'(a)') 'Energies and the VarSave array.'
- do i=1,nsave
- write (iout,'(i5,1pe14.5)') i,esave(i)
- write (iout,'(10f8.3)') (rad2deg*varsave(j,i),j=1,nvar)
- enddo
- endif
- return
- end
-C---------------------------------------------------------------------------
- subroutine perturb(error,lprint,MoveType,nbond,max_phi)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (MMaxSideMove=100)
- include 'COMMON.MCM'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
-crc include 'COMMON.DEFORM1'
- logical error,lprint,fail
- integer MoveType,nbond,end_select,ind_side(MMaxSideMove)
- double precision max_phi
- double precision psi,gen_psi
- external iran_num
- integer iran_num
- integer ifour
- data ifour /4/
- error=.false.
- lprint=.false.
-C Perturb the conformation according to a randomly selected move.
- call SelectMove(MoveType)
-c write (iout,*) 'MoveType=',MoveType
- itrial=0
- goto (100,200,300,400,500) MoveType
-C------------------------------------------------------------------------------
-C Backbone N-bond move.
-C Select the number of bonds (length of the segment to perturb).
- 100 continue
- if (itrial.gt.1000) then
- write (iout,'(a)') 'Too many attempts at multiple-bond move.'
- error=.true.
- return
- endif
- bond_prob=ran_number(0.0D0,sumpro_bond(nbm))
-c print *,'sumpro_bond(nbm)=',sumpro_bond(nbm),
-c & ' Bond_prob=',Bond_Prob
- do i=1,nbm-1
-c print *,i,Bond_Prob,sumpro_bond(i),sumpro_bond(i+1)
- if (bond_prob.ge.sumpro_bond(i) .and.
- & bond_prob.le.sumpro_bond(i+1)) then
- nbond=i+1
- goto 10
- endif
- enddo
- write (iout,'(2a)') 'In PERTURB: Error - number of bonds',
- & ' to move out of range.'
- error=.true.
- return
- 10 continue
- if (nwindow.gt.0) then
-C Select the first residue to perturb
- iwindow=iran_num(1,nwindow)
- print *,'iwindow=',iwindow
- iiwin=1
- do while (winlen(iwindow).lt.nbond)
- iwindow=iran_num(1,nwindow)
- iiwin=iiwin+1
- if (iiwin.gt.1000) then
- write (iout,'(a)') 'Cannot select moveable residues.'
- error=.true.
- return
- endif
- enddo
- nstart=iran_num(winstart(iwindow),winend(iwindow))
- else
- nstart = iran_num(koniecl+2,nres-nbond-koniecl)
-cd print *,'nres=',nres,' nbond=',nbond,' koniecl=',koniecl,
-cd & ' nstart=',nstart
- endif
- psi = gen_psi()
- if (psi.eq.0.0) then
- error=.true.
- return
- endif
- if (print_mc.gt.1) write (iout,'(a,i4,a,i4,a,f8.3)')
- & 'PERTURB: nbond=',nbond,' nstart=',nstart,' psi=',psi*rad2deg
-cd print *,'nstart=',nstart
- call bond_move(nbond,nstart,psi,.false.,error)
- if (error) then
- write (iout,'(2a)')
- & 'Could not define reference system in bond_move, ',
- & 'choosing ahother segment.'
- itrial=itrial+1
- goto 100
- endif
- nbond_move(nbond)=nbond_move(nbond)+1
- moves(1)=moves(1)+1
- nmove=nmove+1
- return
-C------------------------------------------------------------------------------
-C Backbone endmove. Perturb a SINGLE angle of a residue close to the end of
-C the chain.
- 200 continue
- lprint=.true.
-c end_select=iran_num(1,2*koniecl)
-c if (end_select.gt.koniecl) then
-c end_select=nphi-(end_select-koniecl)
-c else
-c end_select=koniecl+3
-c endif
-c if (nwindow.gt.0) then
-c iwin=iran_num(1,nwindow)
-c i1=max0(4,winstart(iwin))
-c i2=min0(winend(imin)+2,nres)
-c end_select=iran_num(i1,i2)
-c else
-c iselect = iran_num(1,nmov_var)
-c jj = 0
-c do i=1,nphi
-c if (isearch_tab(i).eq.1) jj = jj+1
-c if (jj.eq.iselect) then
-c end_select=i+3
-c exit
-c endif
-c enddo
-c endif
- end_select = iran_num(4,nres)
- psi=max_phi*gen_psi()
- if (psi.eq.0.0D0) then
- error=.true.
- return
- endif
- phi(end_select)=pinorm(phi(end_select)+psi)
- if (print_mc.gt.1) write (iout,'(a,i4,a,f8.3,a,f8.3)')
- & 'End angle',end_select,' moved by ',psi*rad2deg,' new angle:',
- & phi(end_select)*rad2deg
-c if (end_select.gt.3)
-c & theta(end_select-1)=gen_theta(itype(end_select-2),
-c & phi(end_select-1),phi(end_select))
-c if (end_select.lt.nres)
-c & theta(end_select)=gen_theta(itype(end_select-1),
-c & phi(end_select),phi(end_select+1))
-cd print *,'nres=',nres,' end_select=',end_select
-cd print *,'theta',end_select-1,theta(end_select-1)
-cd print *,'theta',end_select,theta(end_select)
- moves(2)=moves(2)+1
- nmove=nmove+1
- lprint=.false.
- return
-C------------------------------------------------------------------------------
-C Side chain move.
-C Select the number of SCs to perturb.
- 300 isctry=0
- 301 nside_move=iran_num(1,MaxSideMove)
-c print *,'nside_move=',nside_move,' MaxSideMove',MaxSideMove
-C Select the indices.
- do i=1,nside_move
- icount=0
- 111 inds=iran_num(nnt,nct)
- icount=icount+1
- if (icount.gt.1000) then
- write (iout,'(a)')'Error - cannot select side chains to move.'
- error=.true.
- return
- endif
- if (itype(inds).eq.10) goto 111
- do j=1,i-1
- if (inds.eq.ind_side(j)) goto 111
- enddo
- do j=1,i-1
- if (inds.lt.ind_side(j)) then
- indx=j
- goto 112
- endif
- enddo
- indx=i
- 112 do j=i,indx+1,-1
- ind_side(j)=ind_side(j-1)
- enddo
- 113 ind_side(indx)=inds
- enddo
-C Carry out perturbation.
- do i=1,nside_move
- ii=ind_side(i)
- iti=itype(ii)
- call gen_side(iti,theta(ii+1),alph(ii),omeg(ii),fail)
- if (fail) then
- isctry=isctry+1
- if (isctry.gt.1000) then
- write (iout,'(a)') 'Too many errors in SC generation.'
- error=.true.
- return
- endif
- goto 301
- endif
- if (print_mc.gt.1) write (iout,'(2a,i4,a,2f8.3)')
- & 'Side chain ',restyp(iti),ii,' moved to ',
- & alph(ii)*rad2deg,omeg(ii)*rad2deg
- enddo
- moves(3)=moves(3)+1
- nmove=nmove+1
- return
-C------------------------------------------------------------------------------
-C THETA move
- 400 end_select=iran_num(3,nres)
- theta_new=gen_theta(itype(end_select),phi(end_select),
- & phi(end_select+1))
- if (print_mc.gt.1) write (iout,'(a,i3,a,f8.3,a,f8.3)')
- & 'Theta ',end_select,' moved from',theta(end_select)*rad2deg,
- & ' to ',theta_new*rad2deg
- theta(end_select)=theta_new
- moves(4)=moves(4)+1
- nmove=nmove+1
- return
-C------------------------------------------------------------------------------
-C Error returned from SelectMove.
- 500 error=.true.
- return
- end
-C------------------------------------------------------------------------------
- subroutine SelectMove(MoveType)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.IOUNITS'
- what_move=ran_number(0.0D0,sumpro_type(MaxMoveType))
- do i=1,MaxMoveType
- if (what_move.ge.sumpro_type(i-1).and.
- & what_move.lt.sumpro_type(i)) then
- MoveType=i
- return
- endif
- enddo
- write (iout,'(a)')
- & 'Fatal error in SelectMoveType: cannot select move.'
- MoveType=MaxMoveType+1
- return
- end
-c----------------------------------------------------------------------------
- double precision function gen_psi()
- implicit none
- integer i
- double precision x,ran_number
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- x=0.0D0
- do i=1,100
- x=ran_number(-pi,pi)
- if (dabs(x).gt.angmin) then
- gen_psi=x
- return
- endif
- enddo
- write (iout,'(a)')'From Gen_Psi: Cannot generate angle increment.'
- gen_psi=0.0D0
- return
- end
-c----------------------------------------------------------------------------
- subroutine metropolis(n,xcur,xold,ecur,eold,accepted,similar,
- & enelower)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
-crc include 'COMMON.DEFORM'
- double precision ecur,eold,xx,ran_number,bol
- double precision xcur(n),xold(n)
- double precision ecut1 ,ecut2 ,tola
- logical accepted,similar,not_done,enelower
- logical lprn
- data ecut1 /-1.0D-5/,ecut2 /5.0D-3/,tola/5.0D0/
-! ecut1=-5*enedif
-! ecut2=50*enedif
-! tola=5.0d0
-C Set lprn=.true. for debugging.
- lprn=.false.
- if (lprn)
- &write(iout,*)'enedif',enedif,' ecut1',ecut1,' ecut2',ecut2
- similar=.false.
- enelower=.false.
- accepted=.false.
-C Check if the conformation is similar.
- difene=ecur-eold
- reldife=difene/dmax1(dabs(eold),dabs(ecur),1.0D0)
- if (lprn) then
- write (iout,*) 'Metropolis'
- write(iout,*)'ecur,eold,difene,reldife',ecur,eold,difene,reldife
- endif
-C If energy went down remarkably, we accept the new conformation
-C unconditionally.
-cjp if (reldife.lt.ecut1) then
- if (difene.lt.ecut1) then
- accepted=.true.
- EneLower=.true.
- if (lprn) write (iout,'(a)')
- & 'Conformation accepted, because energy has lowered remarkably.'
-! elseif (reldife.lt.ecut2 .and. dif_ang(nphi,xcur,xold).lt.tola)
-cjp elseif (reldife.lt.ecut2)
- elseif (difene.lt.ecut2)
- & then
-C Reject the conf. if energy has changed insignificantly and there is not
-C much change in conformation.
- if (lprn)
- & write (iout,'(2a)') 'Conformation rejected, because it is',
- & ' similar to the preceding one.'
- accepted=.false.
- similar=.true.
- else
-C Else carry out Metropolis test.
- EneLower=.false.
- xx=ran_number(0.0D0,1.0D0)
- xxh=betbol*difene
- if (lprn)
- & write (iout,*) 'betbol=',betbol,' difene=',difene,' xxh=',xxh
- if (xxh.gt.50.0D0) then
- bol=0.0D0
- else
- bol=exp(-xxh)
- endif
- if (lprn) write (iout,*) 'bol=',bol,' xx=',xx
- if (bol.gt.xx) then
- accepted=.true.
- if (lprn) write (iout,'(a)')
- & 'Conformation accepted, because it passed Metropolis test.'
- else
- accepted=.false.
- if (lprn) write (iout,'(a)')
- & 'Conformation rejected, because it did not pass Metropolis test.'
- endif
- endif
-#ifdef AIX
- call flush_(iout)
-#else
- call flush(iout)
-#endif
- return
- end
-c------------------------------------------------------------------------------
- integer function conf_comp(x,ene)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- double precision etol , angtol
- double precision x(maxvar)
- double precision dif_ang,difa
- data etol /0.1D0/, angtol /20.0D0/
- do ii=nsave,1,-1
-c write (iout,*) 'ii=',ii,'ene=',ene,esave(ii),dabs(ene-esave(ii))
- if (dabs(ene-esave(ii)).lt.etol) then
- difa=dif_ang(nphi,x,varsave(1,ii))
-c do i=1,nphi
-c write(iout,'(i3,3f8.3)')i,rad2deg*x(i),
-c & rad2deg*varsave(i,ii)
-c enddo
-c write(iout,*) 'ii=',ii,' difa=',difa,' angtol=',angtol
- if (difa.le.angtol) then
- if (print_mc.gt.0) then
- write (iout,'(a,i5,2(a,1pe15.4))')
- & 'Current conformation matches #',ii,
- & ' in the store array ene=',ene,' esave=',esave(ii)
-c write (*,'(a,i5,a)') 'Current conformation matches #',ii,
-c & ' in the store array.'
- endif ! print_mc.gt.0
- if (print_mc.gt.1) then
- do i=1,nphi
- write(iout,'(i3,3f8.3)')i,rad2deg*x(i),
- & rad2deg*varsave(i,ii)
- enddo
- endif ! print_mc.gt.1
- nrepm=nrepm+1
- conf_comp=ii
- return
- endif
- endif
- enddo
- conf_comp=0
- return
- end
-C----------------------------------------------------------------------------
- double precision function dif_ang(n,x,y)
- implicit none
- integer i,n
- double precision x(n),y(n)
- double precision w,wa,dif,difa
- double precision pinorm
- include 'COMMON.GEO'
- wa=0.0D0
- difa=0.0D0
- do i=1,n
- dif=dabs(pinorm(y(i)-x(i)))
- if (dabs(dif-dwapi).lt.dif) dif=dabs(dif-dwapi)
- w=1.0D0-(2.0D0*(i-1)/(n-1)-1.0D0)**2+1.0D0/n
- wa=wa+w
- difa=difa+dif*dif*w
- enddo
- dif_ang=rad2deg*dsqrt(difa/wa)
- return
- end
-c--------------------------------------------------------------------------
- subroutine add2cache(n1,n2,ncache,nvar,SourceID,CachSrc,
- & ecur,xcur,ecache,xcache)
- implicit none
- include 'COMMON.GEO'
- include 'COMMON.IOUNITS'
- integer n1,n2,ncache,nvar,SourceID,CachSrc(n2)
- integer i,ii,j
- double precision ecur,xcur(nvar),ecache(n2),xcache(n1,n2)
-cd write (iout,*) 'Enter ADD2CACHE ncache=',ncache ,' ecur',ecur
-cd write (iout,'(10f8.3)') (rad2deg*xcur(i),i=1,nvar)
-cd write (iout,*) 'Old CACHE array:'
-cd do i=1,ncache
-cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i)
-cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar)
-cd enddo
-
- i=ncache
- do while (i.gt.0 .and. ecur.lt.ecache(i))
- i=i-1
- enddo
- i=i+1
-cd write (iout,*) 'i=',i,' ncache=',ncache
- if (ncache.eq.n2) then
- write (iout,*) 'Cache dimension exceeded',ncache,n2
- write (iout,*) 'Highest-energy conformation will be removed.'
- ncache=ncache-1
- endif
- do ii=ncache,i,-1
- ecache(ii+1)=ecache(ii)
- CachSrc(ii+1)=CachSrc(ii)
- do j=1,nvar
- xcache(j,ii+1)=xcache(j,ii)
- enddo
- enddo
- ecache(i)=ecur
- CachSrc(i)=SourceID
- do j=1,nvar
- xcache(j,i)=xcur(j)
- enddo
- ncache=ncache+1
-cd write (iout,*) 'New CACHE array:'
-cd do i=1,ncache
-cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i)
-cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar)
-cd enddo
- return
- end
-c--------------------------------------------------------------------------
- subroutine rm_from_cache(i,n1,n2,ncache,nvar,CachSrc,ecache,
- & xcache)
- implicit none
- include 'COMMON.GEO'
- include 'COMMON.IOUNITS'
- integer n1,n2,ncache,nvar,CachSrc(n2)
- integer i,ii,j
- double precision ecache(n2),xcache(n1,n2)
-
-cd write (iout,*) 'Enter RM_FROM_CACHE'
-cd write (iout,*) 'Old CACHE array:'
-cd do ii=1,ncache
-cd write (iout,*)'i=',ii,' ecache=',ecache(ii),' CachSrc',CachSrc(ii)
-cd write (iout,'(10f8.3)') (rad2deg*xcache(j,ii),j=1,nvar)
-cd enddo
-
- do ii=i+1,ncache
- ecache(ii-1)=ecache(ii)
- CachSrc(ii-1)=CachSrc(ii)
- do j=1,nvar
- xcache(j,ii-1)=xcache(j,ii)
- enddo
- enddo
- ncache=ncache-1
-cd write (iout,*) 'New CACHE array:'
-cd do i=1,ncache
-cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i)
-cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar)
-cd enddo
- return
- end
+++ /dev/null
-#ifdef MPI
- subroutine minim_mcmf
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.MINIM'
- include 'mpif.h'
- external func,gradient,fdum
- real ran1,ran2,ran3
- include 'COMMON.SETUP'
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- dimension muster(mpi_status_size)
- dimension var(maxvar),erg(mxch*(mxch+1)/2+1)
- double precision d(maxvar),v(1:lv+1),garbage(maxvar)
- dimension indx(6)
- dimension iv(liv)
- dimension idum(1),rdum(1)
- double precision przes(3),obrot(3,3)
- logical non_conv
- data rad /1.745329252d-2/
- common /przechowalnia/ v
-
- ichuj=0
- 10 continue
- ichuj = ichuj + 1
- call mpi_recv(indx,6,mpi_integer,king,idint,CG_COMM,
- * muster,ierr)
- if (indx(1).eq.0) return
-c print *, 'worker ',me,' received order ',n,ichuj
- call mpi_recv(var,nvar,mpi_double_precision,
- * king,idreal,CG_COMM,muster,ierr)
- call mpi_recv(ene0,1,mpi_double_precision,
- * king,idreal,CG_COMM,muster,ierr)
-c print *, 'worker ',me,' var read '
-
-
- call deflt(2,iv,liv,lv,v)
-* 12 means fresh start, dont call deflt
- iv(1)=12
-* max num of fun calls
- if (maxfun.eq.0) maxfun=500
- iv(17)=maxfun
-* max num of iterations
- if (maxmin.eq.0) maxmin=1000
- iv(18)=maxmin
-* controls output
- iv(19)=2
-* selects output unit
-c iv(21)=iout
- iv(21)=0
-* 1 means to print out result
- iv(22)=0
-* 1 means to print out summary stats
- iv(23)=0
-* 1 means to print initial x and d
- iv(24)=0
-* min val for v(radfac) default is 0.1
- v(24)=0.1D0
-* max val for v(radfac) default is 4.0
- v(25)=2.0D0
-* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
-* the sumsl default is 0.1
- v(26)=0.1D0
-* false conv if (act fnctn decrease) .lt. v(34)
-* the sumsl default is 100*machep
- v(34)=v(34)/100.0D0
-* absolute convergence
- if (tolf.eq.0.0D0) tolf=1.0D-4
- v(31)=tolf
-* relative convergence
- if (rtolf.eq.0.0D0) rtolf=1.0D-4
- v(32)=rtolf
-* controls initial step size
- v(35)=1.0D-1
-* large vals of d correspond to small components of step
- do i=1,nphi
- d(i)=1.0D-1
- enddo
- do i=nphi+1,nvar
- d(i)=1.0D-1
- enddo
-c minimize energy
-
- call func(nvar,var,nf,eee,idum,rdum,fdum)
- if(eee.gt.1.0d18) then
-c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
-c print *,' energy before SUMSL =',eee
-c print *,' aborting local minimization'
- iv(1)=-1
- v(10)=eee
- nf=1
- go to 201
- endif
-
- call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
-c find which conformation was returned from sumsl
- nf=iv(7)+1
- 201 continue
-c total # of ftn evaluations (for iwf=0, it includes all minimizations).
- indx(4)=nf
- indx(5)=iv(1)
- eee=v(10)
-
- call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM,
- * ierr)
-c print '(a5,i3,15f10.5)', 'ENEX0',indx(1),v(10)
- call mpi_send(var,nvar,mpi_double_precision,
- * king,idreal,CG_COMM,ierr)
- call mpi_send(eee,1,mpi_double_precision,king,idreal,
- * CG_COMM,ierr)
- call mpi_send(ene0,1,mpi_double_precision,king,idreal,
- * CG_COMM,ierr)
- go to 10
-
- return
- end
-#endif
+++ /dev/null
- subroutine minimize(etot,x,iretcode,nfun)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
-*********************************************************************
-* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for *
-* the calling subprogram. *
-* when d(i)=1.0, then v(35) is the length of the initial step, *
-* calculated in the usual pythagorean way. *
-* absolute convergence occurs when the function is within v(31) of *
-* zero. unless you know the minimum value in advance, abs convg *
-* is probably not useful. *
-* relative convergence is when the model predicts that the function *
-* will decrease by less than v(32)*abs(fun). *
-*********************************************************************
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.MINIM'
- common /srutu/ icall
- dimension iv(liv)
- double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar)
- double precision energia(0:n_ene)
- external func,gradient,fdum
- external func_restr,grad_restr
- logical not_done,change,reduce
-c common /przechowalnia/ v
-
- icall = 1
-
- NOT_DONE=.TRUE.
-
-c DO WHILE (NOT_DONE)
-
- call deflt(2,iv,liv,lv,v)
-* 12 means fresh start, dont call deflt
- iv(1)=12
-* max num of fun calls
- if (maxfun.eq.0) maxfun=500
- iv(17)=maxfun
-* max num of iterations
- if (maxmin.eq.0) maxmin=1000
- iv(18)=maxmin
-* controls output
- iv(19)=2
-* selects output unit
- iv(21)=0
- if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout
-* 1 means to print out result
- iv(22)=print_min_res
-* 1 means to print out summary stats
- iv(23)=print_min_stat
-* 1 means to print initial x and d
- iv(24)=print_min_ini
-* min val for v(radfac) default is 0.1
- v(24)=0.1D0
-* max val for v(radfac) default is 4.0
- v(25)=2.0D0
-c v(25)=4.0D0
-* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
-* the sumsl default is 0.1
- v(26)=0.1D0
-* false conv if (act fnctn decrease) .lt. v(34)
-* the sumsl default is 100*machep
- v(34)=v(34)/100.0D0
-* absolute convergence
- if (tolf.eq.0.0D0) tolf=1.0D-4
- v(31)=tolf
-* relative convergence
- if (rtolf.eq.0.0D0) rtolf=1.0D-4
- v(32)=rtolf
-* controls initial step size
- v(35)=1.0D-1
-* large vals of d correspond to small components of step
- do i=1,nphi
- d(i)=1.0D-1
- enddo
- do i=nphi+1,nvar
- d(i)=1.0D-1
- enddo
-cd print *,'Calling SUMSL'
-c call var_to_geom(nvar,x)
-c call chainbuild
-c call etotal(energia(0))
-c etot = energia(0)
- IF (mask_r) THEN
- call x2xx(x,xx,nvar_restr)
- call sumsl(nvar_restr,d,xx,func_restr,grad_restr,
- & iv,liv,lv,v,idum,rdum,fdum)
- call xx2x(x,xx)
- ELSE
- call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
- ENDIF
- etot=v(10)
- iretcode=iv(1)
-cd print *,'Exit SUMSL; return code:',iretcode,' energy:',etot
-cd write (iout,'(/a,i4/)') 'SUMSL return code:',iv(1)
-c call intout
-c change=reduce(x)
- call var_to_geom(nvar,x)
-c if (change) then
-c write (iout,'(a)') 'Reduction worked, minimizing again...'
-c else
-c not_done=.false.
-c endif
- call chainbuild
-c call etotal(energia(0))
-c etot=energia(0)
-c call enerprint(energia(0))
- nfun=iv(6)
-
-c write (*,*) 'Processor',MyID,' leaves MINIMIZE.'
-
-c ENDDO ! NOT_DONE
-
- return
- end
-#ifdef MPI
-c----------------------------------------------------------------------------
- subroutine ergastulum
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
- include 'COMMON.TIME1'
- double precision z(maxres6),d_a_tmp(maxres6)
- double precision edum(0:n_ene),time_order(0:10)
- double precision Gcopy(maxres2,maxres2)
- common /przechowalnia/ Gcopy
- integer icall /0/
-C Workers wait for variables and NF, and NFL from the boss
- iorder=0
- do while (iorder.ge.0)
-c write (*,*) 'Processor',fg_rank,' CG group',kolor,
-c & ' receives order from Master'
- time00=MPI_Wtime()
- call MPI_Bcast(iorder,1,MPI_INTEGER,king,FG_COMM,IERR)
- time_Bcast=time_Bcast+MPI_Wtime()-time00
- if (icall.gt.4 .and. iorder.ge.0)
- & time_order(iorder)=time_order(iorder)+MPI_Wtime()-time00
- icall=icall+1
-c write (*,*)
-c & 'Processor',fg_rank,' completed receive MPI_BCAST order',iorder
- if (iorder.eq.0) then
- call zerograd
- call etotal(edum)
-c write (2,*) "After etotal"
-c write (2,*) "dimen",dimen," dimen3",dimen3
-c call flush(2)
- else if (iorder.eq.2) then
- call zerograd
- call etotal_short(edum)
-c write (2,*) "After etotal_short"
-c write (2,*) "dimen",dimen," dimen3",dimen3
-c call flush(2)
- else if (iorder.eq.3) then
- call zerograd
- call etotal_long(edum)
-c write (2,*) "After etotal_long"
-c write (2,*) "dimen",dimen," dimen3",dimen3
-c call flush(2)
- else if (iorder.eq.1) then
- call sum_gradient
-c write (2,*) "After sum_gradient"
-c write (2,*) "dimen",dimen," dimen3",dimen3
-c call flush(2)
- else if (iorder.eq.4) then
- call ginv_mult(z,d_a_tmp)
- else if (iorder.eq.5) then
-c Setup MD things for a slave
- dimen=(nct-nnt+1)+nside
- dimen1=(nct-nnt)+(nct-nnt+1)
- dimen3=dimen*3
-c write (2,*) "dimen",dimen," dimen3",dimen3
-c call flush(2)
- call int_bounds(dimen,igmult_start,igmult_end)
- igmult_start=igmult_start-1
- call MPI_Allgather(3*igmult_start,1,MPI_INTEGER,
- & ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR)
- my_ng_count=igmult_end-igmult_start
- call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1,
- & MPI_INTEGER,FG_COMM,IERROR)
-c write (2,*) "ng_start",(ng_start(i),i=0,nfgtasks-1)
-c write (2,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1)
- myginv_ng_count=maxres2*my_ng_count
-c write (2,*) "igmult_start",igmult_start," igmult_end",
-c & igmult_end," my_ng_count",my_ng_count
-c call flush(2)
- call MPI_Allgather(maxres2*igmult_start,1,MPI_INTEGER,
- & nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR)
- call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER,
- & nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR)
-c write (2,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1)
-c write (2,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1)
-c call flush(2)
-c call MPI_Barrier(FG_COMM,IERROR)
- time00=MPI_Wtime()
- call MPI_Scatterv(ginv(1,1),nginv_counts(0),
- & nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1),
- & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR)
-#ifdef TIMING
- time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00
-#endif
- do i=1,dimen
- do j=1,2*my_ng_count
- ginv(j,i)=gcopy(i,j)
- enddo
- enddo
-c write (2,*) "dimen",dimen," dimen3",dimen3
-c write (2,*) "End MD setup"
-c call flush(2)
-c write (iout,*) "My chunk of ginv_block"
-c call MATOUT2(my_ng_count,dimen3,maxres2,maxers2,ginv_block)
- else if (iorder.eq.6) then
- call int_from_cart1(.false.)
- else if (iorder.eq.7) then
- call chainbuild_cart
- else if (iorder.eq.8) then
- call intcartderiv
- else if (iorder.eq.9) then
- call fricmat_mult(z,d_a_tmp)
- else if (iorder.eq.10) then
- call setup_fricmat
- endif
- enddo
- write (*,*) 'Processor',fg_rank,' CG group',kolor,
- & ' absolute rank',myrank,' leves ERGASTULUM.'
- write(*,*)'Processor',fg_rank,' wait times for respective orders',
- & (' order[',i,']',time_order(i),i=0,10)
- return
- end
-#endif
-************************************************************************
- subroutine func(n,x,nf,f,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- common /chuju/ jjj
- double precision energia(0:n_ene)
- integer jjj
- double precision ufparm
- external ufparm
- integer uiparm(1)
- real*8 urparm(1)
- dimension x(maxvar)
-c if (jjj.gt.0) then
-c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
-c endif
- nfl=nf
- icg=mod(nf,2)+1
-cd print *,'func',nf,nfl,icg
- call var_to_geom(n,x)
- call zerograd
- call chainbuild
-cd write (iout,*) 'ETOTAL called from FUNC'
- call etotal(energia(0))
- call sum_gradient
- f=energia(0)
-c if (jjj.gt.0) then
-c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
-c write (iout,*) 'f=',etot
-c jjj=0
-c endif
- return
- end
-************************************************************************
- subroutine func_restr(n,x,nf,f,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- common /chuju/ jjj
- double precision energia(0:n_ene)
- integer jjj
- double precision ufparm
- external ufparm
- integer uiparm(1)
- real*8 urparm(1)
- dimension x(maxvar)
-c if (jjj.gt.0) then
-c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
-c endif
- nfl=nf
- icg=mod(nf,2)+1
- call var_to_geom_restr(n,x)
- call zerograd
- call chainbuild
-cd write (iout,*) 'ETOTAL called from FUNC'
- call etotal(energia(0))
- call sum_gradient
- f=energia(0)
-c if (jjj.gt.0) then
-c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
-c write (iout,*) 'f=',etot
-c jjj=0
-c endif
- return
- end
-c-------------------------------------------------------
- subroutine x2xx(x,xx,n)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- double precision xx(maxvar),x(maxvar)
-
- do i=1,nvar
- varall(i)=x(i)
- enddo
-
- ig=0
- igall=0
- do i=4,nres
- igall=igall+1
- if (mask_phi(i).eq.1) then
- ig=ig+1
- xx(ig)=x(igall)
- endif
- enddo
-
- do i=3,nres
- igall=igall+1
- if (mask_theta(i).eq.1) then
- ig=ig+1
- xx(ig)=x(igall)
- endif
- enddo
-
- do ij=1,2
- do i=2,nres-1
- if (itype(i).ne.10) then
- igall=igall+1
- if (mask_side(i).eq.1) then
- ig=ig+1
- xx(ig)=x(igall)
- endif
- endif
- enddo
- enddo
-
- n=ig
-
- return
- end
-
- subroutine xx2x(x,xx)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- double precision xx(maxvar),x(maxvar)
-
- do i=1,nvar
- x(i)=varall(i)
- enddo
-
- ig=0
- igall=0
- do i=4,nres
- igall=igall+1
- if (mask_phi(i).eq.1) then
- ig=ig+1
- x(igall)=xx(ig)
- endif
- enddo
-
- do i=3,nres
- igall=igall+1
- if (mask_theta(i).eq.1) then
- ig=ig+1
- x(igall)=xx(ig)
- endif
- enddo
-
- do ij=1,2
- do i=2,nres-1
- if (itype(i).ne.10) then
- igall=igall+1
- if (mask_side(i).eq.1) then
- ig=ig+1
- x(igall)=xx(ig)
- endif
- endif
- enddo
- enddo
-
- return
- end
-
-c----------------------------------------------------------
- subroutine minim_dc(etot,iretcode,nfun)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.MINIM'
- include 'COMMON.CHAIN'
- dimension iv(liv)
- double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar)
-c common /przechowalnia/ v
-
- double precision energia(0:n_ene)
- external func_dc,grad_dc,fdum
- logical not_done,change,reduce
- double precision g(maxvar),f1
-
- call deflt(2,iv,liv,lv,v)
-* 12 means fresh start, dont call deflt
- iv(1)=12
-* max num of fun calls
- if (maxfun.eq.0) maxfun=500
- iv(17)=maxfun
-* max num of iterations
- if (maxmin.eq.0) maxmin=1000
- iv(18)=maxmin
-* controls output
- iv(19)=2
-* selects output unit
- iv(21)=0
- if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout
-* 1 means to print out result
- iv(22)=print_min_res
-* 1 means to print out summary stats
- iv(23)=print_min_stat
-* 1 means to print initial x and d
- iv(24)=print_min_ini
-* min val for v(radfac) default is 0.1
- v(24)=0.1D0
-* max val for v(radfac) default is 4.0
- v(25)=2.0D0
-c v(25)=4.0D0
-* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
-* the sumsl default is 0.1
- v(26)=0.1D0
-* false conv if (act fnctn decrease) .lt. v(34)
-* the sumsl default is 100*machep
- v(34)=v(34)/100.0D0
-* absolute convergence
- if (tolf.eq.0.0D0) tolf=1.0D-4
- v(31)=tolf
-* relative convergence
- if (rtolf.eq.0.0D0) rtolf=1.0D-4
- v(32)=rtolf
-* controls initial step size
- v(35)=1.0D-1
-* large vals of d correspond to small components of step
- do i=1,6*nres
- d(i)=1.0D-1
- enddo
-
- k=0
- do i=1,nres-1
- do j=1,3
- k=k+1
- x(k)=dc(j,i)
- enddo
- enddo
- do i=2,nres-1
- if (ialph(i,1).gt.0) then
- do j=1,3
- k=k+1
- x(k)=dc(j,i+nres)
- enddo
- endif
- enddo
-
- call sumsl(k,d,x,func_dc,grad_dc,iv,liv,lv,v,idum,rdum,fdum)
-
- k=0
- do i=1,nres-1
- do j=1,3
- k=k+1
- dc(j,i)=x(k)
- enddo
- enddo
- do i=2,nres-1
- if (ialph(i,1).gt.0) then
- do j=1,3
- k=k+1
- dc(j,i+nres)=x(k)
- enddo
- endif
- enddo
- call chainbuild_cart
-
-cd call zerograd
-cd nf=0
-cd call func_dc(k,x,nf,f,idum,rdum,fdum)
-cd call grad_dc(k,x,nf,g,idum,rdum,fdum)
-cd
-cd do i=1,k
-cd x(i)=x(i)+1.0D-5
-cd call func_dc(k,x,nf,f1,idum,rdum,fdum)
-cd x(i)=x(i)-1.0D-5
-cd print '(i5,2f15.5)',i,g(i),(f1-f)/1.0D-5
-cd enddo
-
- etot=v(10)
- iretcode=iv(1)
- nfun=iv(6)
- return
- end
-
- subroutine func_dc(n,x,nf,f,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- double precision energia(0:n_ene)
- double precision ufparm
- external ufparm
- integer uiparm(1)
- real*8 urparm(1)
- dimension x(maxvar)
- nfl=nf
-cbad icg=mod(nf,2)+1
- icg=1
-
- k=0
- do i=1,nres-1
- do j=1,3
- k=k+1
- dc(j,i)=x(k)
- enddo
- enddo
- do i=2,nres-1
- if (ialph(i,1).gt.0) then
- do j=1,3
- k=k+1
- dc(j,i+nres)=x(k)
- enddo
- endif
- enddo
- call chainbuild_cart
-
- call zerograd
- call etotal(energia(0))
- f=energia(0)
-
-cd print *,'func_dc ',nf,nfl,f
-
- return
- end
-
- subroutine grad_dc(n,x,nf,g,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.MD'
- include 'COMMON.IOUNITS'
- external ufparm
- integer uiparm(1),k
- double precision urparm(1)
- dimension x(maxvar),g(maxvar)
-c
-c
-c
-cbad icg=mod(nf,2)+1
- icg=1
-cd print *,'grad_dc ',nf,nfl,nf-nfl+1,icg
- if (nf-nfl+1) 20,30,40
- 20 call func_dc(n,x,nf,f,uiparm,urparm,ufparm)
-cd print *,20
- if (nf.eq.0) return
- goto 40
- 30 continue
-cd print *,30
- k=0
- do i=1,nres-1
- do j=1,3
- k=k+1
- dc(j,i)=x(k)
- enddo
- enddo
- do i=2,nres-1
- if (ialph(i,1).gt.0) then
- do j=1,3
- k=k+1
- dc(j,i+nres)=x(k)
- enddo
- endif
- enddo
- call chainbuild_cart
-
-C
-C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-C
- 40 call cartgrad
-cd print *,40
- k=0
- do i=1,nres-1
- do j=1,3
- k=k+1
- g(k)=gcart(j,i)
- enddo
- enddo
- do i=2,nres-1
- if (ialph(i,1).gt.0) then
- do j=1,3
- k=k+1
- g(k)=gxcart(j,i)
- enddo
- endif
- enddo
-
- return
- end
+++ /dev/null
-C $Date: 1994/10/12 17:24:21 $
-C $Revision: 2.5 $
-C
-C
-C
- logical function find_arg(ipos,line,errflag)
- parameter (maxlen=80)
- character*80 line
- character*1 empty /' '/,equal /'='/
- logical errflag
-* This function returns .TRUE., if an argument follows keyword keywd; if so
-* IPOS will point to the first non-blank character of the argument. Returns
-* .FALSE., if no argument follows the keyword; in this case IPOS points
-* to the first non-blank character of the next keyword.
- do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen)
- ipos=ipos+1
- enddo
- errflag=.false.
- if (line(ipos:ipos).eq.equal) then
- find_arg=.true.
- ipos=ipos+1
- do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen)
- ipos=ipos+1
- enddo
- if (ipos.gt.maxlen) errflag=.true.
- else
- find_arg=.false.
- endif
- return
- end
- logical function find_group(iunit,jout,key1)
- character*(*) key1
- character*80 karta,ucase
- integer ilen
- external ilen
- logical lcom
- rewind (iunit)
- karta=' '
- ll=ilen(key1)
- do while (index(ucase(karta),key1(1:ll)).eq.0.or.lcom(1,karta))
- read (iunit,'(a)',end=10) karta
- enddo
- write (jout,'(2a)') '> ',karta(1:78)
- find_group=.true.
- return
- 10 find_group=.false.
- return
- end
- logical function iblnk(charc)
- character*1 charc
- integer n
- n = ichar(charc)
- iblnk = (n.eq.9) .or. (n.eq.10) .or. (charc.eq. ' ')
- return
- end
- integer function ilen(string)
- character*(*) string
- logical iblnk
-
- ilen = len(string)
-1 if ( ilen .gt. 0 ) then
- if ( iblnk( string(ilen:ilen) ) ) then
- ilen = ilen - 1
- goto 1
- endif
- endif
- return
- end
- integer function in_keywd_set(nkey,ikey,narg,keywd,keywdset)
- character*16 keywd,keywdset(1:nkey,0:nkey)
- character*16 ucase
- do i=1,narg
- if (ucase(keywd).eq.keywdset(i,ikey)) then
-* Match found
- in_keywd_set=i
- return
- endif
- enddo
-* No match to the allowed set of keywords if this point is reached.
- in_keywd_set=0
- return
- end
- character*(*) function lcase(string)
- integer i, k, idiff
- character*(*) string
- character*1 c
- character*40 chtmp
-c
- i = len(lcase)
- k = len(string)
- if (i .lt. k) then
- k = i
- if (string(k+1:) .ne. ' ') then
- chtmp = string
- endif
- endif
- idiff = ichar('a') - ichar('A')
- lcase = string
- do 99 i = 1, k
- c = string(i:i)
- if (lge(c,'A') .and. lle(c,'Z')) then
- lcase(i:i) = char(ichar(c) + idiff)
- endif
- 99 continue
- return
- end
- logical function lcom(ipos,karta)
- character*80 karta
- character koment(2) /'!','#'/
- lcom=.false.
- do i=1,2
- if (karta(ipos:ipos).eq.koment(i)) lcom=.true.
- enddo
- return
- end
- logical function lower_case(ch)
- character*(*) ch
- lower_case=(ch.ge.'a' .and. ch.le.'z')
- return
- end
- subroutine mykey(line,keywd,ipos,blankline,errflag)
-* This subroutine seeks a non-empty substring keywd in the string LINE.
-* The substring begins with the first character different from blank and
-* "=" encountered right to the pointer IPOS (inclusively) and terminates
-* at the character left to the first blank or "=". When the subroutine is
-* exited, the pointer IPOS is moved to the position of the terminator in LINE.
-* The logical variable BLANKLINE is set at .TRUE., if LINE(IPOS:) contains
-* only separators or the maximum length of the data line (80) has been reached.
-* The logical variable ERRFLAG is set at .TRUE. if the string
-* consists only from a "=".
- parameter (maxlen=80)
- character*1 empty /' '/,equal /'='/,comma /','/
- character*(*) keywd
- character*80 line
- logical blankline,errflag,lcom
- errflag=.false.
- do while (line(ipos:ipos).eq.empty .and. (ipos.le.maxlen))
- ipos=ipos+1
- enddo
- if (ipos.gt.maxlen .or. lcom(ipos,line) ) then
-* At this point the rest of the input line turned out to contain only blanks
-* or to be commented out.
- blankline=.true.
- return
- endif
- blankline=.false.
- istart=ipos
-* Checks whether the current char is a separator.
- do while (line(ipos:ipos).ne.empty .and. line(ipos:ipos).ne.equal
- & .and. line(ipos:ipos).ne.comma .and. ipos.le.maxlen)
- ipos=ipos+1
- enddo
- iend=ipos-1
-* Error flag set to .true., if the length of the keyword was found less than 1.
- if (iend.lt.istart) then
- errflag=.true.
- return
- endif
- keywd=line(istart:iend)
- return
- end
- subroutine numstr(inum,numm)
- character*10 huj /'0123456789'/
- character*(*) numm
- inumm=inum
- inum1=inumm/10
- inum2=inumm-10*inum1
- inumm=inum1
- numm(3:3)=huj(inum2+1:inum2+1)
- inum1=inumm/10
- inum2=inumm-10*inum1
- inumm=inum1
- numm(2:2)=huj(inum2+1:inum2+1)
- inum1=inumm/10
- inum2=inumm-10*inum1
- inumm=inum1
- numm(1:1)=huj(inum2+1:inum2+1)
- return
- end
- character*(*) function ucase(string)
- integer i, k, idiff
- character*(*) string
- character*1 c
- character*40 chtmp
-c
- i = len(ucase)
- k = len(string)
- if (i .lt. k) then
- k = i
- if (string(k+1:) .ne. ' ') then
- chtmp = string
- endif
- endif
- idiff = ichar('a') - ichar('A')
- ucase = string
- do 99 i = 1, k
- c = string(i:i)
- if (lge(c,'a') .and. lle(c,'z')) then
- ucase(i:i) = char(ichar(c) - idiff)
- endif
- 99 continue
- return
- end
+++ /dev/null
- subroutine inertia_tensor
-c Calculating the intertia tensor for the entire protein in order to
-c remove the perpendicular components of velocity matrix which cause
-c the molecule to rotate.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-
- double precision Im(3,3),Imcp(3,3),cm(3),pr(3),M_SC,
- & eigvec(3,3),Id(3,3),eigval(3),L(3),vp(3),vrot(3),
- & vpp(3,0:MAXRES),vs_p(3),pr1(3,3),
- & pr2(3,3),pp(3),incr(3),v(3),mag,mag2
- common /gucio/ cm
- integer iti,inres
- do i=1,3
- do j=1,3
- Im(i,j)=0.0d0
- pr1(i,j)=0.0d0
- pr2(i,j)=0.0d0
- enddo
- L(i)=0.0d0
- cm(i)=0.0d0
- vrot(i)=0.0d0
- enddo
-c calculating the center of the mass of the protein
- do i=nnt,nct-1
- do j=1,3
- cm(j)=cm(j)+c(j,i)+0.5d0*dc(j,i)
- enddo
- enddo
- do j=1,3
- cm(j)=mp*cm(j)
- enddo
- M_SC=0.0d0
- do i=nnt,nct
- iti=itype(i)
- M_SC=M_SC+msc(iti)
- inres=i+nres
- do j=1,3
- cm(j)=cm(j)+msc(iti)*c(j,inres)
- enddo
- enddo
- do j=1,3
- cm(j)=cm(j)/(M_SC+(nct-nnt)*mp)
- enddo
-
- do i=nnt,nct-1
- do j=1,3
- pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j)
- enddo
- Im(1,1)=Im(1,1)+mp*(pr(2)*pr(2)+pr(3)*pr(3))
- Im(1,2)=Im(1,2)-mp*pr(1)*pr(2)
- Im(1,3)=Im(1,3)-mp*pr(1)*pr(3)
- Im(2,3)=Im(2,3)-mp*pr(2)*pr(3)
- Im(2,2)=Im(2,2)+mp*(pr(3)*pr(3)+pr(1)*pr(1))
- Im(3,3)=Im(3,3)+mp*(pr(1)*pr(1)+pr(2)*pr(2))
- enddo
-
- do i=nnt,nct
- iti=itype(i)
- inres=i+nres
- do j=1,3
- pr(j)=c(j,inres)-cm(j)
- enddo
- Im(1,1)=Im(1,1)+msc(iti)*(pr(2)*pr(2)+pr(3)*pr(3))
- Im(1,2)=Im(1,2)-msc(iti)*pr(1)*pr(2)
- Im(1,3)=Im(1,3)-msc(iti)*pr(1)*pr(3)
- Im(2,3)=Im(2,3)-msc(iti)*pr(2)*pr(3)
- Im(2,2)=Im(2,2)+msc(iti)*(pr(3)*pr(3)+pr(1)*pr(1))
- Im(3,3)=Im(3,3)+msc(iti)*(pr(1)*pr(1)+pr(2)*pr(2))
- enddo
-
- do i=nnt,nct-1
- Im(1,1)=Im(1,1)+Ip*(1-dc_norm(1,i)*dc_norm(1,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(1,2)=Im(1,2)+Ip*(-dc_norm(1,i)*dc_norm(2,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(1,3)=Im(1,3)+Ip*(-dc_norm(1,i)*dc_norm(3,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(2,3)=Im(2,3)+Ip*(-dc_norm(2,i)*dc_norm(3,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(2,2)=Im(2,2)+Ip*(1-dc_norm(2,i)*dc_norm(2,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- Im(3,3)=Im(3,3)+Ip*(1-dc_norm(3,i)*dc_norm(3,i))*
- & vbld(i+1)*vbld(i+1)*0.25d0
- enddo
-
-
- do i=nnt,nct
- if (itype(i).ne.10) then
- iti=itype(i)
- inres=i+nres
- Im(1,1)=Im(1,1)+Isc(iti)*(1-dc_norm(1,inres)*
- & dc_norm(1,inres))*vbld(inres)*vbld(inres)
- Im(1,2)=Im(1,2)-Isc(iti)*(dc_norm(1,inres)*
- & dc_norm(2,inres))*vbld(inres)*vbld(inres)
- Im(1,3)=Im(1,3)-Isc(iti)*(dc_norm(1,inres)*
- & dc_norm(3,inres))*vbld(inres)*vbld(inres)
- Im(2,3)=Im(2,3)-Isc(iti)*(dc_norm(2,inres)*
- & dc_norm(3,inres))*vbld(inres)*vbld(inres)
- Im(2,2)=Im(2,2)+Isc(iti)*(1-dc_norm(2,inres)*
- & dc_norm(2,inres))*vbld(inres)*vbld(inres)
- Im(3,3)=Im(3,3)+Isc(iti)*(1-dc_norm(3,inres)*
- & dc_norm(3,inres))*vbld(inres)*vbld(inres)
- endif
- enddo
-
- call angmom(cm,L)
-c write(iout,*) "The angular momentum before adjustment:"
-c write(iout,*) (L(j),j=1,3)
-
- Im(2,1)=Im(1,2)
- Im(3,1)=Im(1,3)
- Im(3,2)=Im(2,3)
-
-c Copying the Im matrix for the djacob subroutine
- do i=1,3
- do j=1,3
- Imcp(i,j)=Im(i,j)
- Id(i,j)=0.0d0
- enddo
- enddo
-
-c Finding the eigenvectors and eignvalues of the inertia tensor
- call djacob(3,3,10000,1.0d-10,Imcp,eigvec,eigval)
-c write (iout,*) "Eigenvalues & Eigenvectors"
-c write (iout,'(5x,3f10.5)') (eigval(i),i=1,3)
-c write (iout,*)
-c do i=1,3
-c write (iout,'(i5,3f10.5)') i,(eigvec(i,j),j=1,3)
-c enddo
-c Constructing the diagonalized matrix
- do i=1,3
- if (dabs(eigval(i)).gt.1.0d-15) then
- Id(i,i)=1.0d0/eigval(i)
- else
- Id(i,i)=0.0d0
- endif
- enddo
- do i=1,3
- do j=1,3
- Imcp(i,j)=eigvec(j,i)
- enddo
- enddo
- do i=1,3
- do j=1,3
- do k=1,3
- pr1(i,j)=pr1(i,j)+Id(i,k)*Imcp(k,j)
- enddo
- enddo
- enddo
- do i=1,3
- do j=1,3
- do k=1,3
- pr2(i,j)=pr2(i,j)+eigvec(i,k)*pr1(k,j)
- enddo
- enddo
- enddo
-c Calculating the total rotational velocity of the molecule
- do i=1,3
- do j=1,3
- vrot(i)=vrot(i)+pr2(i,j)*L(j)
- enddo
- enddo
-c Resetting the velocities
- do i=nnt,nct-1
- call vecpr(vrot(1),dc(1,i),vp)
- do j=1,3
- d_t(j,i)=d_t(j,i)-vp(j)
- enddo
- enddo
- do i=nnt,nct
- if(itype(i).ne.10) then
- inres=i+nres
- call vecpr(vrot(1),dc(1,inres),vp)
- do j=1,3
- d_t(j,inres)=d_t(j,inres)-vp(j)
- enddo
- endif
- enddo
- call angmom(cm,L)
-c write(iout,*) "The angular momentum after adjustment:"
-c write(iout,*) (L(j),j=1,3)
- return
- end
-c----------------------------------------------------------------------------
- subroutine angmom(cm,L)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
-
- double precision L(3),cm(3),pr(3),vp(3),vrot(3),incr(3),v(3),
- & pp(3)
- integer iti,inres
-c Calculate the angular momentum
- do j=1,3
- L(j)=0.0d0
- enddo
- do j=1,3
- incr(j)=d_t(j,0)
- enddo
- do i=nnt,nct-1
- do j=1,3
- pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j)
- enddo
- do j=1,3
- v(j)=incr(j)+0.5d0*d_t(j,i)
- enddo
- do j=1,3
- incr(j)=incr(j)+d_t(j,i)
- enddo
- call vecpr(pr(1),v(1),vp)
- do j=1,3
- L(j)=L(j)+mp*vp(j)
- enddo
- do j=1,3
- pr(j)=0.5d0*dc(j,i)
- pp(j)=0.5d0*d_t(j,i)
- enddo
- call vecpr(pr(1),pp(1),vp)
- do j=1,3
- L(j)=L(j)+Ip*vp(j)
- enddo
- enddo
- do j=1,3
- incr(j)=d_t(j,0)
- enddo
- do i=nnt,nct
- iti=itype(i)
- inres=i+nres
- do j=1,3
- pr(j)=c(j,inres)-cm(j)
- enddo
- if (itype(i).ne.10) then
- do j=1,3
- v(j)=incr(j)+d_t(j,inres)
- enddo
- else
- do j=1,3
- v(j)=incr(j)
- enddo
- endif
- call vecpr(pr(1),v(1),vp)
-c write (iout,*) "i",i," iti",iti," pr",(pr(j),j=1,3),
-c & " v",(v(j),j=1,3)," vp",(vp(j),j=1,3)
- do j=1,3
- L(j)=L(j)+msc(iti)*vp(j)
- enddo
-c write (iout,*) "L",(l(j),j=1,3)
- if (itype(i).ne.10) then
- do j=1,3
- v(j)=incr(j)+d_t(j,inres)
- enddo
- call vecpr(dc(1,inres),d_t(1,inres),vp)
- do j=1,3
- L(j)=L(j)+Isc(iti)*vp(j)
- enddo
- endif
- do j=1,3
- incr(j)=incr(j)+d_t(j,i)
- enddo
- enddo
- return
- end
-c------------------------------------------------------------------------------
- subroutine vcm_vel(vcm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- double precision vcm(3),vv(3),summas,amas
- do j=1,3
- vcm(j)=0.0d0
- vv(j)=d_t(j,0)
- enddo
- summas=0.0d0
- do i=nnt,nct
- if (i.lt.nct) then
- summas=summas+mp
- do j=1,3
- vcm(j)=vcm(j)+mp*(vv(j)+0.5d0*d_t(j,i))
- enddo
- endif
- amas=msc(itype(i))
- summas=summas+amas
- if (itype(i).ne.10) then
- do j=1,3
- vcm(j)=vcm(j)+amas*(vv(j)+d_t(j,i+nres))
- enddo
- else
- do j=1,3
- vcm(j)=vcm(j)+amas*vv(j)
- enddo
- endif
- do j=1,3
- vv(j)=vv(j)+d_t(j,i)
- enddo
- enddo
-c write (iout,*) "vcm",(vcm(j),j=1,3)," summas",summas
- do j=1,3
- vcm(j)=vcm(j)/summas
- enddo
- return
- end
+++ /dev/null
- subroutine muca_delta(remd_t_bath,remd_ene,i,iex,delta)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.MD'
- double precision remd_t_bath(maxprocs)
- double precision remd_ene(maxprocs)
- double precision muca_ene
- double precision betai,betaiex,delta
-
- betai=1.0/(Rb*remd_t_bath(i))
- betaiex=1.0/(Rb*remd_t_bath(iex))
-
- delta=betai*(muca_ene(remd_ene(iex),i,remd_t_bath)-
- & muca_ene(remd_ene(i),i,remd_t_bath))
- & -betaiex*(muca_ene(remd_ene(iex),iex,remd_t_bath)-
- & muca_ene(remd_ene(i),iex,remd_t_bath))
-
- return
- end
-
- double precision function muca_ene(energy,i,remd_t_bath)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.MD'
- double precision y,yp,energy
- double precision remd_t_bath(maxprocs)
- integer i
-
- if (energy.lt.elowi(i)) then
- call splint(emuca,nemuca,nemuca2,nmuca,elowi(i),y,yp)
- muca_ene=remd_t_bath(i)*Rb*(yp*(energy-elowi(i))+y)
- elseif (energy.gt.ehighi(i)) then
- call splint(emuca,nemuca,nemuca2,nmuca,ehighi(i),y,yp)
- muca_ene=remd_t_bath(i)*Rb*(yp*(energy-ehighi(i))+y)
- else
- call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp)
- muca_ene=remd_t_bath(i)*Rb*y
- endif
- return
- end
-
- subroutine read_muca
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.CONTROL'
- include 'COMMON.MD'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision yp1,ypn,yp,x,muca_factor,y,muca_ene
- imtime=0
- do i=1,4*maxres
- hist(i)=0
- enddo
- if (modecalc.eq.14.and..not.remd_tlist) then
- print *,"MUCAREMD works only with TLIST"
- stop
- endif
- open(89,file='muca.input')
- read(89,*)
- read(89,*)
- if (modecalc.eq.14) then
- read(89,*) (elowi(i),ehighi(i),i=1,nrep)
- if (remd_mlist) then
- k=0
- do i=1,nrep
- do j=1,remd_m(i)
- i2rep(k)=i
- k=k+1
- enddo
- enddo
- elow=elowi(i2rep(me))
- ehigh=ehighi(i2rep(me))
- elowi(me+1)=elow
- ehighi(me+1)=ehigh
- else
- elow=elowi(me+1)
- ehigh=ehighi(me+1)
- endif
- else
- read(89,*) elow,ehigh
- elowi(1)=elow
- ehighi(1)=ehigh
- endif
- i=0
- do while(.true.)
- i=i+1
- read(89,*,end=100) emuca(i),nemuca(i)
-cd nemuca(i)=nemuca(i)*remd_t(me+1)*Rb
- enddo
- 100 continue
- nmuca=i-1
- hbin=emuca(nmuca)-emuca(nmuca-1)
- write (iout,*) 'hbin',hbin
- write (iout,*) me,'elow,ehigh',elow,ehigh
- yp1=0
- ypn=0
- call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2)
- factor_min=0.0d0
- factor_min=muca_factor(ehigh)
- call print_muca
- return
- end
-
-
- subroutine print_muca
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.CONTROL'
- include 'COMMON.MD'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision yp1,ypn,yp,x,muca_factor,y,muca_ene
- double precision dummy(maxprocs)
-
- if (remd_mlist) then
- k=0
- do i=1,nrep
- do j=1,remd_m(i)
- i2rep(k)=i
- k=k+1
- enddo
- enddo
- endif
-
- do i=1,nmuca
-c print *,'nemuca ',emuca(i),nemuca(i)
- do j=0,4
- x=emuca(i)+hbin/5*j
- if (modecalc.eq.14) then
- if (remd_mlist) then
- yp=muca_factor(x)*remd_t(i2rep(me))*Rb
- dummy(me+1)=remd_t(i2rep(me))
- y=muca_ene(x,me+1,dummy)
- else
- yp=muca_factor(x)*remd_t(me+1)*Rb
- y=muca_ene(x,me+1,remd_t)
- endif
- write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime,
- & 'muca factor ',x,yp,' muca ene',y
- else
- yp=muca_factor(x)*t_bath*Rb
- dummy(1)=t_bath
- y=muca_ene(x,1,dummy)
- write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime,
- & 'muca factor ',x,yp,' muca ene',y
- endif
- enddo
- enddo
- if(mucadyn.gt.0) then
- do i=1,nmuca
- write(iout,'(a13,i8,2f12.5)') 'nemuca after ',
- & imtime,emuca(i),nemuca(i)
- enddo
- endif
- return
- end
-
- subroutine muca_update(energy)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- include 'COMMON.CONTROL'
- include 'COMMON.MD'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- double precision energy
- double precision yp1,ypn
- integer k
- logical lnotend
-
- k=int((energy-emuca(1))/hbin)+1
-
- IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN
- if(energy.ge.ehigh)
- & write (iout,*) 'MUCA reject',energy,emuca(k)
- if(energy.ge.ehigh.and.(energy-ehigh).lt.hbin) then
- write (iout,*) 'MUCA ehigh',energy,emuca(k)
- do i=k,nmuca
- hist(i)=hist(i)+1
- enddo
- endif
- if(k.gt.0.and.energy.lt.ehigh) hist(k)=hist(k)+1
- ELSE
- if(k.gt.0.and.k.lt.4*maxres) hist(k)=hist(k)+1
- ENDIF
- if(mod(imtime,mucadyn).eq.0) then
-
- do i=1,nmuca
- IF(muca_smooth.eq.2.or.muca_smooth.eq.3) THEN
- nemuca(i)=nemuca(i)+dlog(hist(i)+1)
- ELSE
- if (hist(i).gt.0) hist(i)=dlog(hist(i))
- nemuca(i)=nemuca(i)+hist(i)
- ENDIF
- hist(i)=0
- write(iout,'(a24,i8,2f12.5)')'nemuca before smoothing ',
- & imtime,emuca(i),nemuca(i)
- enddo
-
-
- lnotend=.true.
- ismooth=0
- ist=2
- ien=nmuca-1
- IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN
-c lnotend=.false.
-c do i=1,nmuca-1
-c do j=i+1,nmuca
-c if(nemuca(j).lt.nemuca(i)) lnotend=.true.
-c enddo
-c enddo
- do while(lnotend)
- ismooth=ismooth+1
- write (iout,*) 'MUCA update smoothing',ist,ien
- do i=ist,ien
- nemuca(i)=(nemuca(i-1)+nemuca(i)+nemuca(i+1))/3
- enddo
- lnotend=.false.
- ist=0
- ien=0
- do i=1,nmuca-1
- do j=i+1,nmuca
- if(nemuca(j).lt.nemuca(i)) then
- lnotend=.true.
- if(ist.eq.0) ist=i-1
- if(ien.lt.j+1) ien=j+1
- endif
- enddo
- enddo
- enddo
- ENDIF
-
- write (iout,*) 'MUCA update ',imtime,' smooth= ',ismooth
- yp1=0
- ypn=0
- call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2)
- call print_muca
-
- endif
- return
- end
-
- double precision function muca_factor(energy)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MUCA'
- double precision y,yp,energy
-
- if (energy.lt.elow) then
- call splint(emuca,nemuca,nemuca2,nmuca,elow,y,yp)
- elseif (energy.gt.ehigh) then
- call splint(emuca,nemuca,nemuca2,nmuca,ehigh,y,yp)
- else
- call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp)
- endif
-
- if(yp.ge.factor_min) then
- muca_factor=yp
- else
- muca_factor=factor_min
- endif
-cd print *,'energy, muca_factor',energy,muca_factor
- return
- end
-
-
- SUBROUTINE spline(x,y,n,yp1,ypn,y2)
- INTEGER n,NMAX
- REAL*8 yp1,ypn,x(n),y(n),y2(n)
- PARAMETER (NMAX=500)
- INTEGER i,k
- REAL*8 p,qn,sig,un,u(NMAX)
- if (yp1.gt..99e30) then
- y2(1)=0.
- u(1)=0.
- else
- y2(1)=-0.5
- u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
- endif
- do i=2,n-1
- sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
- p=sig*y2(i-1)+2.
- y2(i)=(sig-1.)/p
- u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1))
- * /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p
- enddo
- if (ypn.gt..99e30) then
- qn=0.
- un=0.
- else
- qn=0.5
- un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
- endif
- y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.)
- do k=n-1,1,-1
- y2(k)=y2(k)*y2(k+1)+u(k)
- enddo
- return
- END
-
-
- SUBROUTINE splint(xa,ya,y2a,n,x,y,yp)
- INTEGER n
- REAL*8 x,y,xa(n),y2a(n),ya(n),yp
- INTEGER k,khi,klo
- REAL*8 a,b,h
- klo=1
- khi=n
- 1 if (khi-klo.gt.1) then
- k=(khi+klo)/2
- if (xa(k).gt.x) then
- khi=k
- else
- klo=k
- endif
- goto 1
- endif
- h=xa(khi)-xa(klo)
- if (h.eq.0.) pause 'bad xa input in splint'
- a=(xa(khi)-x)/h
- b=(x-xa(klo))/h
- y=a*ya(klo)+b*ya(khi)+
- * ((a**3-a)*y2a(klo)+(b**3-b)*y2a(khi))*(h**2)/6.
- yp=-ya(klo)/h+ya(khi)/h-3*(a**2)*y2a(klo)*h/6.
- + +(3*(b**2)-1)*y2a(khi)*h/6.
- return
- END
+++ /dev/null
- subroutine parmread
-C
-C Read the parameters of the probability distributions of the virtual-bond
-C valence angles and the side chains and energy parameters.
-C
-C Important! Energy-term weights ARE NOT read here; they are read from the
-C main input file instead, because NO defaults have yet been set for these
-C parameters.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
- integer IERROR
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.TORSION'
- include 'COMMON.SCCOR'
- include 'COMMON.SCROT'
- include 'COMMON.FFIELD'
- include 'COMMON.NAMES'
- include 'COMMON.SBRIDGE'
- include 'COMMON.MD'
- include 'COMMON.SETUP'
- character*1 t1,t2,t3
- character*1 onelett(4) /"G","A","P","D"/
- logical lprint,LaTeX
- dimension blower(3,3,maxlob)
- dimension b(13)
- character*3 lancuch,ucase
-C
-C For printing parameters after they are read set the following in the UNRES
-C C-shell script:
-C
-C setenv PRINT_PARM YES
-C
-C To print parameters in LaTeX format rather than as ASCII tables:
-C
-C setenv LATEX YES
-C
- call getenv_loc("PRINT_PARM",lancuch)
- lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y")
- call getenv_loc("LATEX",lancuch)
- LaTeX = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y")
-C
- dwa16=2.0d0**(1.0d0/6.0d0)
- itypro=20
-C Assign virtual-bond length
- vbl=3.8D0
- vblinv=1.0D0/vbl
- vblinv2=vblinv*vblinv
-c
-c Read the virtual-bond parameters, masses, and moments of inertia
-c and Stokes' radii of the peptide group and side chains
-c
-#ifdef CRYST_BOND
- read (ibond,*) vbldp0,akp,mp,ip,pstok
- do i=1,ntyp
- nbondterm(i)=1
- read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i)
- dsc(i) = vbldsc0(1,i)
- if (i.eq.10) then
- dsc_inv(i)=0.0D0
- else
- dsc_inv(i)=1.0D0/dsc(i)
- endif
- enddo
-#else
- read (ibond,*) junk,vbldp0,akp,rjunk,mp,ip,pstok
- do i=1,ntyp
- read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i),
- & j=1,nbondterm(i)),msc(i),isc(i),restok(i)
- dsc(i) = vbldsc0(1,i)
- if (i.eq.10) then
- dsc_inv(i)=0.0D0
- else
- dsc_inv(i)=1.0D0/dsc(i)
- endif
- enddo
-#endif
- if (lprint) then
- write(iout,'(/a/)')"Dynamic constants of the interaction sites:"
- write (iout,'(a10,a3,6a10)') 'Type','N','VBL','K','A0','mass',
- & 'inertia','Pstok'
- write(iout,'(a10,i3,6f10.5)') "p",1,vbldp0,akp,0.0d0,mp,ip,pstok
- do i=1,ntyp
- write (iout,'(a10,i3,6f10.5)') restyp(i),nbondterm(i),
- & vbldsc0(1,i),aksc(1,i),abond0(1,i),msc(i),isc(i),restok(i)
- do j=2,nbondterm(i)
- write (iout,'(13x,3f10.5)')
- & vbldsc0(j,i),aksc(j,i),abond0(j,i)
- enddo
- enddo
- endif
-#ifdef CRYST_THETA
-C
-C Read the parameters of the probability distribution/energy expression
-C of the virtual-bond valence angles theta
-C
- do i=1,ntyp
- read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2),
- & (bthet(j,i),j=1,2)
- read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3)
- read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3)
- read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i)
- sigc0(i)=sigc0(i)**2
- enddo
- close (ithep)
- if (lprint) then
- if (.not.LaTeX) then
- write (iout,'(a)')
- & 'Parameters of the virtual-bond valence angles:'
- write (iout,'(/a/9x,5a/79(1h-))') 'Fourier coefficients:',
- & ' ATHETA0 ',' A1 ',' A2 ',
- & ' B1 ',' B2 '
- do i=1,ntyp
- write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,
- & a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2)
- enddo
- write (iout,'(/a/9x,5a/79(1h-))')
- & 'Parameters of the expression for sigma(theta_c):',
- & ' ALPH0 ',' ALPH1 ',' ALPH2 ',
- & ' ALPH3 ',' SIGMA0C '
- do i=1,ntyp
- write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,
- & (polthet(j,i),j=0,3),sigc0(i)
- enddo
- write (iout,'(/a/9x,5a/79(1h-))')
- & 'Parameters of the second gaussian:',
- & ' THETA0 ',' SIGMA0 ',' G1 ',
- & ' G2 ',' G3 '
- do i=1,ntyp
- write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,theta0(i),
- & sig0(i),(gthet(j,i),j=1,3)
- enddo
- else
- write (iout,'(a)')
- & 'Parameters of the virtual-bond valence angles:'
- write (iout,'(/a/9x,5a/79(1h-))')
- & 'Coefficients of expansion',
- & ' theta0 ',' a1*10^2 ',' a2*10^2 ',
- & ' b1*10^1 ',' b2*10^1 '
- do i=1,ntyp
- write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),
- & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2)
- enddo
- write (iout,'(/a/9x,5a/79(1h-))')
- & 'Parameters of the expression for sigma(theta_c):',
- & ' alpha0 ',' alph1 ',' alph2 ',
- & ' alhp3 ',' sigma0c '
- do i=1,ntyp
- write (iout,'(a3,1h&,2x,5(1pe12.3,1h&))') restyp(i),
- & (polthet(j,i),j=0,3),sigc0(i)
- enddo
- write (iout,'(/a/9x,5a/79(1h-))')
- & 'Parameters of the second gaussian:',
- & ' theta0 ',' sigma0*10^2 ',' G1*10^-1',
- & ' G2 ',' G3*10^1 '
- do i=1,ntyp
- write (iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),theta0(i),
- & 100*sig0(i),gthet(1,i)*0.1D0,gthet(2,i),gthet(3,i)*10.0D0
- enddo
- endif
- endif
-#else
-C
-C Read the parameters of Utheta determined from ab initio surfaces
-C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
-C
- read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2,
- & ntheterm3,nsingle,ndouble
- nntheterm=max0(ntheterm,ntheterm2,ntheterm3)
- read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1)
- do i=1,maxthetyp
- do j=1,maxthetyp
- do k=1,maxthetyp
- aa0thet(i,j,k)=0.0d0
- do l=1,ntheterm
- aathet(l,i,j,k)=0.0d0
- enddo
- do l=1,ntheterm2
- do m=1,nsingle
- bbthet(m,l,i,j,k)=0.0d0
- ccthet(m,l,i,j,k)=0.0d0
- ddthet(m,l,i,j,k)=0.0d0
- eethet(m,l,i,j,k)=0.0d0
- enddo
- enddo
- do l=1,ntheterm3
- do m=1,ndouble
- do mm=1,ndouble
- ffthet(mm,m,l,i,j,k)=0.0d0
- ggthet(mm,m,l,i,j,k)=0.0d0
- enddo
- enddo
- enddo
- enddo
- enddo
- enddo
- do i=1,nthetyp
- do j=1,nthetyp
- do k=1,nthetyp
- read (ithep,'(3a)',end=111,err=111) res1,res2,res3
- read (ithep,*,end=111,err=111) aa0thet(i,j,k)
- read (ithep,*,end=111,err=111)(aathet(l,i,j,k),l=1,ntheterm)
- read (ithep,*,end=111,err=111)
- & ((bbthet(lll,ll,i,j,k),lll=1,nsingle),
- & (ccthet(lll,ll,i,j,k),lll=1,nsingle),
- & (ddthet(lll,ll,i,j,k),lll=1,nsingle),
- & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2)
- read (ithep,*,end=111,err=111)
- & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k),
- & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k),
- & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3)
- enddo
- enddo
- enddo
-C
-C For dummy ends assign glycine-type coefficients of theta-only terms; the
-C coefficients of theta-and-gamma-dependent terms are zero.
-C
- do i=1,nthetyp
- do j=1,nthetyp
- do l=1,ntheterm
- aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1)
- aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j)
- enddo
- aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1)
- aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j)
- enddo
- do l=1,ntheterm
- aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1)
- enddo
- aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1)
- enddo
-C
-C Control printout of the coefficients of virtual-bond-angle potentials
-C
- if (lprint) then
- write (iout,'(//a)') 'Parameter of virtual-bond-angle potential'
- do i=1,nthetyp+1
- do j=1,nthetyp+1
- do k=1,nthetyp+1
- write (iout,'(//4a)')
- & 'Type ',onelett(i),onelett(j),onelett(k)
- write (iout,'(//a,10x,a)') " l","a[l]"
- write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k)
- write (iout,'(i2,1pe15.5)')
- & (l,aathet(l,i,j,k),l=1,ntheterm)
- do l=1,ntheterm2
- write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))')
- & "b",l,"c",l,"d",l,"e",l
- do m=1,nsingle
- write (iout,'(i2,4(1pe15.5))') m,
- & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k),
- & ddthet(m,l,i,j,k),eethet(m,l,i,j,k)
- enddo
- enddo
- do l=1,ntheterm3
- write (iout,'(//3hm,n,4(6x,a,5h[m,n,,i1,1h]))')
- & "f+",l,"f-",l,"g+",l,"g-",l
- do m=2,ndouble
- do n=1,m-1
- write (iout,'(i1,1x,i1,4(1pe15.5))') n,m,
- & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k),
- & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k)
- enddo
- enddo
- enddo
- enddo
- enddo
- enddo
- call flush(iout)
- endif
- write (2,*) "Start reading THETA_PDB"
- do i=1,ntyp
- read (ithep_pdb,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2),
- & (bthet(j,i),j=1,2)
- read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3)
- read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3)
- read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i)
- sigc0(i)=sigc0(i)**2
- enddo
- write (2,*) "End reading THETA_PDB"
- close (ithep_pdb)
-#endif
- close(ithep)
-#ifdef CRYST_SC
-C
-C Read the parameters of the probability distribution/energy expression
-C of the side chains.
-C
- do i=1,ntyp
- read (irotam,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i)
- if (i.eq.10) then
- dsc_inv(i)=0.0D0
- else
- dsc_inv(i)=1.0D0/dsc(i)
- endif
- if (i.ne.10) then
- do j=1,nlob(i)
- do k=1,3
- do l=1,3
- blower(l,k,j)=0.0D0
- enddo
- enddo
- enddo
- bsc(1,i)=0.0D0
- read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3),
- & ((blower(k,l,1),l=1,k),k=1,3)
- do j=2,nlob(i)
- read (irotam,*,end=112,err=112) bsc(j,i)
- read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3),
- & ((blower(k,l,j),l=1,k),k=1,3)
- enddo
- do j=1,nlob(i)
- do k=1,3
- do l=1,k
- akl=0.0D0
- do m=1,3
- akl=akl+blower(k,m,j)*blower(l,m,j)
- enddo
- gaussc(k,l,j,i)=akl
- gaussc(l,k,j,i)=akl
- enddo
- enddo
- enddo
- endif
- enddo
- close (irotam)
- if (lprint) then
- write (iout,'(/a)') 'Parameters of side-chain local geometry'
- do i=1,ntyp
- nlobi=nlob(i)
- if (nlobi.gt.0) then
- if (LaTeX) then
- write (iout,'(/3a,i2,a,f8.3)') 'Residue type: ',restyp(i),
- & ' # of gaussian lobes:',nlobi,' dsc:',dsc(i)
- write (iout,'(1h&,a,3(2h&&,f8.3,2h&&))')
- & 'log h',(bsc(j,i),j=1,nlobi)
- write (iout,'(1h&,a,3(1h&,f8.3,1h&,f8.3,1h&,f8.3,1h&))')
- & 'x',((censc(k,j,i),k=1,3),j=1,nlobi)
- do k=1,3
- write (iout,'(2h& ,5(2x,1h&,3(f7.3,1h&)))')
- & ((gaussc(k,l,j,i),l=1,3),j=1,nlobi)
- enddo
- else
- write (iout,'(/a,8x,i1,4(25x,i1))') 'Lobe:',(j,j=1,nlobi)
- write (iout,'(a,f10.4,4(16x,f10.4))')
- & 'Center ',(bsc(j,i),j=1,nlobi)
- write (iout,'(5(2x,3f8.4))') ((censc(k,j,i),k=1,3),
- & j=1,nlobi)
- write (iout,'(a)')
- endif
- endif
- enddo
- endif
-#else
-C
-C Read scrot parameters for potentials determined from all-atom AM1 calculations
-C added by Urszula Kozlowska 07/11/2007
-C
- do i=1,ntyp
- read (irotam,*,end=112,err=112)
- if (i.eq.10) then
- read (irotam,*,end=112,err=112)
- else
- do j=1,65
- read(irotam,*,end=112,err=112) sc_parmin(j,i)
- enddo
- endif
- enddo
-C
-C Read the parameters of the probability distribution/energy expression
-C of the side chains.
-C
- do i=1,ntyp
- read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i)
- if (i.eq.10) then
- dsc_inv(i)=0.0D0
- else
- dsc_inv(i)=1.0D0/dsc(i)
- endif
- if (i.ne.10) then
- do j=1,nlob(i)
- do k=1,3
- do l=1,3
- blower(l,k,j)=0.0D0
- enddo
- enddo
- enddo
- bsc(1,i)=0.0D0
- read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3),
- & ((blower(k,l,1),l=1,k),k=1,3)
- do j=2,nlob(i)
- read (irotam_pdb,*,end=112,err=112) bsc(j,i)
- read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3),
- & ((blower(k,l,j),l=1,k),k=1,3)
- enddo
- do j=1,nlob(i)
- do k=1,3
- do l=1,k
- akl=0.0D0
- do m=1,3
- akl=akl+blower(k,m,j)*blower(l,m,j)
- enddo
- gaussc(k,l,j,i)=akl
- gaussc(l,k,j,i)=akl
- enddo
- enddo
- enddo
- endif
- enddo
- close (irotam_pdb)
-#endif
- close(irotam)
-
-#ifdef CRYST_TOR
-C
-C Read torsional parameters in old format
-C
- read (itorp,*,end=113,err=113) ntortyp,nterm_old
- if (lprint)write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old
- read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp)
- do i=1,ntortyp
- do j=1,ntortyp
- read (itorp,'(a)')
- do k=1,nterm_old
- read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i)
- enddo
- enddo
- enddo
- close (itorp)
- if (lprint) then
- write (iout,'(/a/)') 'Torsional constants:'
- do i=1,ntortyp
- do j=1,ntortyp
- write (iout,'(2i3,6f10.5)') i,j,(v1(k,i,j),k=1,nterm_old)
- write (iout,'(6x,6f10.5)') (v2(k,i,j),k=1,nterm_old)
- enddo
- enddo
- endif
-#else
-C
-C Read torsional parameters
-C
- read (itorp,*,end=113,err=113) ntortyp
- read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp)
-c write (iout,*) 'ntortyp',ntortyp
- do i=1,ntortyp
- do j=1,ntortyp
- read (itorp,*,end=113,err=113) nterm(i,j),nlor(i,j)
- v0ij=0.0d0
- si=-1.0d0
- do k=1,nterm(i,j)
- read (itorp,*,end=113,err=113) kk,v1(k,i,j),v2(k,i,j)
- v0ij=v0ij+si*v1(k,i,j)
- si=-si
- enddo
- do k=1,nlor(i,j)
- read (itorp,*,end=113,err=113) kk,vlor1(k,i,j),
- & vlor2(k,i,j),vlor3(k,i,j)
- v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2)
- enddo
- v0(i,j)=v0ij
- enddo
- enddo
- close (itorp)
- if (lprint) then
- write (iout,'(/a/)') 'Torsional constants:'
- do i=1,ntortyp
- do j=1,ntortyp
- write (iout,*) 'ityp',i,' jtyp',j
- write (iout,*) 'Fourier constants'
- do k=1,nterm(i,j)
- write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j)
- enddo
- write (iout,*) 'Lorenz constants'
- do k=1,nlor(i,j)
- write (iout,'(3(1pe15.5))')
- & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j)
- enddo
- enddo
- enddo
- endif
-C
-C 6/23/01 Read parameters for double torsionals
-C
- do i=1,ntortyp
- do j=1,ntortyp
- do k=1,ntortyp
- read (itordp,'(3a1)',end=114,err=114) t1,t2,t3
- if (t1.ne.onelett(i) .or. t2.ne.onelett(j)
- & .or. t3.ne.onelett(k)) then
- write (iout,*) "Error in double torsional parameter file",
- & i,j,k,t1,t2,t3
-#ifdef MPI
- call MPI_Finalize(Ierror)
-#endif
- stop "Error in double torsional parameter file"
- endif
- read (itordp,*,end=114,err=114) ntermd_1(i,j,k),
- & ntermd_2(i,j,k)
- read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k),l=1,
- & ntermd_1(i,j,k))
- read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k),l=1,
- & ntermd_1(i,j,k))
- read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k),l=1,
- & ntermd_1(i,j,k))
- read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k),l=1,
- & ntermd_1(i,j,k))
- read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k),
- & v2c(m,l,i,j,k),v2s(l,m,i,j,k),v2s(m,l,i,j,k),
- & m=1,l-1),l=1,ntermd_2(i,j,k))
- enddo
- enddo
- enddo
- if (lprint) then
- write (iout,*)
- write (iout,*) 'Constants for double torsionals'
- do i=1,ntortyp
- do j=1,ntortyp
- do k=1,ntortyp
- write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k,
- & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k)
- write (iout,*)
- write (iout,*) 'Single angles:'
- do l=1,ntermd_1(i,j,k)
- write (iout,'(i5,2f10.5,5x,2f10.5)') l,
- & v1c(1,l,i,j,k),v1s(1,l,i,j,k),
- & v1c(2,l,i,j,k),v1s(2,l,i,j,k)
- enddo
- write (iout,*)
- write (iout,*) 'Pairs of angles:'
- write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k))
- do l=1,ntermd_2(i,j,k)
- write (iout,'(i5,20f10.5)')
- & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k))
- enddo
- write (iout,*)
- write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k))
- do l=1,ntermd_2(i,j,k)
- write (iout,'(i5,20f10.5)')
- & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k))
- enddo
- write (iout,*)
- enddo
- enddo
- enddo
- endif
-#endif
-C Read of Side-chain backbone correlation parameters
-C Modified 11 May 2012 by Adasko
-CCC
-C
- read (isccor,*,end=1113,err=1113) nsccortyp
- read (isccor,*,end=1113,err=1113) (isccortyp(i),i=1,ntyp)
-c write (iout,*) 'ntortyp',ntortyp
- maxinter=3
-cc maxinter is maximum interaction sites
- do l=1,maxinter
- do i=1,nsccortyp
- do j=1,nsccortyp
- read (isccor,*,end=1113,err=1113) nterm_sccor(i,j),
- & nlor_sccor(i,j)
- v0ijsccor=0.0d0
- si=-1.0d0
-
- do k=1,nterm_sccor(i,j)
- read (isccor,*,end=1113,err=1113) kk,v1sccor(k,l,i,j)
- & ,v2sccor(k,l,i,j)
- v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j)
- si=-si
- enddo
- do k=1,nlor_sccor(i,j)
- read (isccor,*,end=1113,err=1113) kk,vlor1sccor(k,i,j),
- & vlor2sccor(k,i,j),vlor3sccor(k,i,j)
- v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/
- &(1+vlor3sccor(k,i,j)**2)
- enddo
- v0sccor(i,j)=v0ijsccor
- enddo
- enddo
- enddo
- close (isccor)
-
- if (lprint) then
- write (iout,'(/a/)') 'Torsional constants:'
- do i=1,nsccortyp
- do j=1,nsccortyp
- write (iout,*) 'ityp',i,' jtyp',j
- write (iout,*) 'Fourier constants'
- do k=1,nterm_sccor(i,j)
- write (iout,'(2(1pe15.5))') v1sccor(k,l,i,j),v2sccor(k,l,i,j)
- enddo
- write (iout,*) 'Lorenz constants'
- do k=1,nlor_sccor(i,j)
- write (iout,'(3(1pe15.5))')
- & vlor1sccor(k,i,j),vlor2sccor(k,i,j),vlor3sccor(k,i,j)
- enddo
- enddo
- enddo
- endif
-C
-C
-C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local
-C interaction energy of the Gly, Ala, and Pro prototypes.
-C
- if (lprint) then
- write (iout,*)
- write (iout,*) "Coefficients of the cumulants"
- endif
- read (ifourier,*) nloctyp
- do i=1,nloctyp
- read (ifourier,*,end=115,err=115)
- read (ifourier,*,end=115,err=115) (b(ii),ii=1,13)
- if (lprint) then
- write (iout,*) 'Type',i
- write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii),ii=1,13)
- endif
- B1(1,i) = b(3)
- B1(2,i) = b(5)
-c b1(1,i)=0.0d0
-c b1(2,i)=0.0d0
- B1tilde(1,i) = b(3)
- B1tilde(2,i) =-b(5)
-c b1tilde(1,i)=0.0d0
-c b1tilde(2,i)=0.0d0
- B2(1,i) = b(2)
- B2(2,i) = b(4)
-c b2(1,i)=0.0d0
-c b2(2,i)=0.0d0
- CC(1,1,i)= b(7)
- CC(2,2,i)=-b(7)
- CC(2,1,i)= b(9)
- CC(1,2,i)= b(9)
-c CC(1,1,i)=0.0d0
-c CC(2,2,i)=0.0d0
-c CC(2,1,i)=0.0d0
-c CC(1,2,i)=0.0d0
- Ctilde(1,1,i)=b(7)
- Ctilde(1,2,i)=b(9)
- Ctilde(2,1,i)=-b(9)
- Ctilde(2,2,i)=b(7)
-c Ctilde(1,1,i)=0.0d0
-c Ctilde(1,2,i)=0.0d0
-c Ctilde(2,1,i)=0.0d0
-c Ctilde(2,2,i)=0.0d0
- DD(1,1,i)= b(6)
- DD(2,2,i)=-b(6)
- DD(2,1,i)= b(8)
- DD(1,2,i)= b(8)
-c DD(1,1,i)=0.0d0
-c DD(2,2,i)=0.0d0
-c DD(2,1,i)=0.0d0
-c DD(1,2,i)=0.0d0
- Dtilde(1,1,i)=b(6)
- Dtilde(1,2,i)=b(8)
- Dtilde(2,1,i)=-b(8)
- Dtilde(2,2,i)=b(6)
-c Dtilde(1,1,i)=0.0d0
-c Dtilde(1,2,i)=0.0d0
-c Dtilde(2,1,i)=0.0d0
-c Dtilde(2,2,i)=0.0d0
- EE(1,1,i)= b(10)+b(11)
- EE(2,2,i)=-b(10)+b(11)
- EE(2,1,i)= b(12)-b(13)
- EE(1,2,i)= b(12)+b(13)
-c ee(1,1,i)=1.0d0
-c ee(2,2,i)=1.0d0
-c ee(2,1,i)=0.0d0
-c ee(1,2,i)=0.0d0
-c ee(2,1,i)=ee(1,2,i)
- enddo
- if (lprint) then
- do i=1,nloctyp
- write (iout,*) 'Type',i
- write (iout,*) 'B1'
- write(iout,*) B1(1,i),B1(2,i)
- write (iout,*) 'B2'
- write(iout,*) B2(1,i),B2(2,i)
- write (iout,*) 'CC'
- do j=1,2
- write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i)
- enddo
- write(iout,*) 'DD'
- do j=1,2
- write (iout,'(2f10.5)') DD(j,1,i),DD(j,2,i)
- enddo
- write(iout,*) 'EE'
- do j=1,2
- write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i)
- enddo
- enddo
- endif
-C
-C Read electrostatic-interaction parameters
-C
- if (lprint) then
- write (iout,*)
- write (iout,'(/a)') 'Electrostatic interaction constants:'
- write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)')
- & 'IT','JT','APP','BPP','AEL6','AEL3'
- endif
- read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2)
- read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2)
- read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2)
- read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2)
- close (ielep)
- do i=1,2
- do j=1,2
- rri=rpp(i,j)**6
- app (i,j)=epp(i,j)*rri*rri
- bpp (i,j)=-2.0D0*epp(i,j)*rri
- ael6(i,j)=elpp6(i,j)*4.2D0**6
- ael3(i,j)=elpp3(i,j)*4.2D0**3
- if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j),
- & ael6(i,j),ael3(i,j)
- enddo
- enddo
-C
-C Read side-chain interaction parameters.
-C
- read (isidep,*,end=117,err=117) ipot,expon
- if (ipot.lt.1 .or. ipot.gt.5) then
- write (iout,'(2a)') 'Error while reading SC interaction',
- & 'potential file - unknown potential type.'
-#ifdef MPI
- call MPI_Finalize(Ierror)
-#endif
- stop
- endif
- expon2=expon/2
- if(me.eq.king)
- & write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot),
- & ', exponents are ',expon,2*expon
- goto (10,20,30,30,40) ipot
-C----------------------- LJ potential ---------------------------------
- 10 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp),
- & (sigma0(i),i=1,ntyp)
- if (lprint) then
- write (iout,'(/a/)') 'Parameters of the LJ potential:'
- write (iout,'(a/)') 'The epsilon array:'
- call printmat(ntyp,ntyp,ntyp,iout,restyp,eps)
- write (iout,'(/a)') 'One-body parameters:'
- write (iout,'(a,4x,a)') 'residue','sigma'
- write (iout,'(a3,6x,f10.5)') (restyp(i),sigma0(i),i=1,ntyp)
- endif
- goto 50
-C----------------------- LJK potential --------------------------------
- 20 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp),
- & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp)
- if (lprint) then
- write (iout,'(/a/)') 'Parameters of the LJK potential:'
- write (iout,'(a/)') 'The epsilon array:'
- call printmat(ntyp,ntyp,ntyp,iout,restyp,eps)
- write (iout,'(/a)') 'One-body parameters:'
- write (iout,'(a,4x,2a)') 'residue',' sigma ',' r0 '
- write (iout,'(a3,6x,2f10.5)') (restyp(i),sigma0(i),rr0(i),
- & i=1,ntyp)
- endif
- goto 50
-C---------------------- GB or BP potential -----------------------------
- 30 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp),
- & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip(i),i=1,ntyp),
- & (alp(i),i=1,ntyp)
-C For the GB potential convert sigma'**2 into chi'
- if (ipot.eq.4) then
- do i=1,ntyp
- chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0)
- enddo
- endif
- if (lprint) then
- write (iout,'(/a/)') 'Parameters of the BP potential:'
- write (iout,'(a/)') 'The epsilon array:'
- call printmat(ntyp,ntyp,ntyp,iout,restyp,eps)
- write (iout,'(/a)') 'One-body parameters:'
- write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2',
- & ' chip ',' alph '
- write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i),
- & chip(i),alp(i),i=1,ntyp)
- endif
- goto 50
-C--------------------- GBV potential -----------------------------------
- 40 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp),
- & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp),
- & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp)
- if (lprint) then
- write (iout,'(/a/)') 'Parameters of the GBV potential:'
- write (iout,'(a/)') 'The epsilon array:'
- call printmat(ntyp,ntyp,ntyp,iout,restyp,eps)
- write (iout,'(/a)') 'One-body parameters:'
- write (iout,'(a,4x,5a)') 'residue',' sigma ',' r0 ',
- & 's||/s_|_^2',' chip ',' alph '
- write (iout,'(a3,6x,5f10.5)') (restyp(i),sigma0(i),rr0(i),
- & sigii(i),chip(i),alp(i),i=1,ntyp)
- endif
- 50 continue
- close (isidep)
-C-----------------------------------------------------------------------
-C Calculate the "working" parameters of SC interactions.
- do i=2,ntyp
- do j=1,i-1
- eps(i,j)=eps(j,i)
- enddo
- enddo
- do i=1,ntyp
- do j=i,ntyp
- sigma(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2)
- sigma(j,i)=sigma(i,j)
- rs0(i,j)=dwa16*sigma(i,j)
- rs0(j,i)=rs0(i,j)
- enddo
- enddo
- if (lprint) write (iout,'(/a/10x,7a/72(1h-))')
- & 'Working parameters of the SC interactions:',
- & ' a ',' b ',' augm ',' sigma ',' r0 ',
- & ' chi1 ',' chi2 '
- do i=1,ntyp
- do j=i,ntyp
- epsij=eps(i,j)
- if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then
- rrij=sigma(i,j)
- else
- rrij=rr0(i)+rr0(j)
- endif
- r0(i,j)=rrij
- r0(j,i)=rrij
- rrij=rrij**expon
- epsij=eps(i,j)
- sigeps=dsign(1.0D0,epsij)
- epsij=dabs(epsij)
- aa(i,j)=epsij*rrij*rrij
- bb(i,j)=-sigeps*epsij*rrij
- aa(j,i)=aa(i,j)
- bb(j,i)=bb(i,j)
- if (ipot.gt.2) then
- sigt1sq=sigma0(i)**2
- sigt2sq=sigma0(j)**2
- sigii1=sigii(i)
- sigii2=sigii(j)
- ratsig1=sigt2sq/sigt1sq
- ratsig2=1.0D0/ratsig1
- chi(i,j)=(sigii1-1.0D0)/(sigii1+ratsig1)
- if (j.gt.i) chi(j,i)=(sigii2-1.0D0)/(sigii2+ratsig2)
- rsum_max=dsqrt(sigii1*sigt1sq+sigii2*sigt2sq)
- else
- rsum_max=sigma(i,j)
- endif
-c if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then
- sigmaii(i,j)=rsum_max
- sigmaii(j,i)=rsum_max
-c else
-c sigmaii(i,j)=r0(i,j)
-c sigmaii(j,i)=r0(i,j)
-c endif
-cd write (iout,*) i,j,r0(i,j),sigma(i,j),rsum_max
- if ((ipot.eq.2 .or. ipot.eq.5) .and. r0(i,j).gt.rsum_max) then
- r_augm=sigma(i,j)*(rrij-sigma(i,j))/rrij
- augm(i,j)=epsij*r_augm**(2*expon)
-c augm(i,j)=0.5D0**(2*expon)*aa(i,j)
- augm(j,i)=augm(i,j)
- else
- augm(i,j)=0.0D0
- augm(j,i)=0.0D0
- endif
- if (lprint) then
- write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))')
- & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j),
- & sigma(i,j),r0(i,j),chi(i,j),chi(j,i)
- endif
- enddo
- enddo
-#ifdef OLDSCP
-C
-C Define the SC-p interaction constants (hard-coded; old style)
-C
- do i=1,20
-C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates
-C helix formation)
-c aad(i,1)=0.3D0*4.0D0**12
-C Following line for constants currently implemented
-C "Hard" SC-p repulsion (gives correct turn spacing in helices)
- aad(i,1)=1.5D0*4.0D0**12
-c aad(i,1)=0.17D0*5.6D0**12
- aad(i,2)=aad(i,1)
-C "Soft" SC-p repulsion
- bad(i,1)=0.0D0
-C Following line for constants currently implemented
-c aad(i,1)=0.3D0*4.0D0**6
-C "Hard" SC-p repulsion
- bad(i,1)=3.0D0*4.0D0**6
-c bad(i,1)=-2.0D0*0.17D0*5.6D0**6
- bad(i,2)=bad(i,1)
-c aad(i,1)=0.0D0
-c aad(i,2)=0.0D0
-c bad(i,1)=1228.8D0
-c bad(i,2)=1228.8D0
- enddo
-#else
-C
-C 8/9/01 Read the SC-p interaction constants from file
-C
- do i=1,ntyp
- read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2)
- enddo
- do i=1,ntyp
- aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12
- aad(i,2)=dabs(eps_scp(i,2))*rscp(i,2)**12
- bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6
- bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6
- enddo
-
- if (lprint) then
- write (iout,*) "Parameters of SC-p interactions:"
- do i=1,20
- write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1),
- & eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2)
- enddo
- endif
-#endif
-C
-C Define the constants of the disulfide bridge
-C
- ebr=-5.50D0
-c
-c Old arbitrary potential - commented out.
-c
-c dbr= 4.20D0
-c fbr= 3.30D0
-c
-c Constants of the disulfide-bond potential determined based on the RHF/6-31G**
-c energy surface of diethyl disulfide.
-c A. Liwo and U. Kozlowska, 11/24/03
-c
- D0CM = 3.78d0
- AKCM = 15.1d0
- AKTH = 11.0d0
- AKCT = 12.0d0
- V1SS =-1.08d0
- V2SS = 7.61d0
- V3SS = 13.7d0
-c akcm=0.0d0
-c akth=0.0d0
-c akct=0.0d0
-c v1ss=0.0d0
-c v2ss=0.0d0
-c v3ss=0.0d0
-
- if(me.eq.king) then
- write (iout,'(/a)') "Disulfide bridge parameters:"
- write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr
- write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm
- write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct
- write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss,
- & ' v3ss:',v3ss
- endif
- return
- 111 write (iout,*) "Error reading bending energy parameters."
- goto 999
- 112 write (iout,*) "Error reading rotamer energy parameters."
- goto 999
- 113 write (iout,*) "Error reading torsional energy parameters."
- goto 999
- 1113 write (iout,*)
- & "Error reading side-chain torsional energy parameters."
- goto 999
- 114 write (iout,*) "Error reading double torsional energy parameters."
- goto 999
- 115 write (iout,*)
- & "Error reading cumulant (multibody energy) parameters."
- goto 999
- 116 write (iout,*) "Error reading electrostatic energy parameters."
- goto 999
- 117 write (iout,*) "Error reading side chain interaction parameters."
- goto 999
- 118 write (iout,*) "Error reading SCp interaction parameters."
- goto 999
- 119 write (iout,*) "Error reading SCCOR parameters"
- 999 continue
-#ifdef MPI
- call MPI_Finalize(Ierror)
-#endif
- stop
- return
- end
-
-
- subroutine getenv_loc(var, val)
- character(*) var, val
-
-#ifdef WINIFL
- character(2000) line
- external ilen
-
- open (196,file='env',status='old',readonly,shared)
- iread=0
-c write(*,*)'looking for ',var
-10 read(196,*,err=11,end=11)line
- iread=index(line,var)
-c write(*,*)iread,' ',var,' ',line
- if (iread.eq.0) go to 10
-c write(*,*)'---> ',line
-11 continue
- if(iread.eq.0) then
-c write(*,*)'CHUJ'
- val=''
- else
- iread=iread+ilen(var)+1
- read (line(iread:),*,err=12,end=12) val
-c write(*,*)'OK: ',var,' = ',val
- endif
- close(196)
- return
-12 val=''
- close(196)
-#elif (defined CRAY)
- integer lennam,lenval,ierror
-c
-c getenv using a POSIX call, useful on the T3D
-c Sept 1996, comment out error check on advice of H. Pritchard
-c
- lennam = len(var)
- if(lennam.le.0) stop '--error calling getenv--'
- call pxfgetenv(var,lennam,val,lenval,ierror)
-c-HP- if(ierror.ne.0) stop '--error returned by pxfgetenv--'
-#else
- call getenv(var,val)
-#endif
-
- return
- end
+++ /dev/null
- double precision function pinorm(x)
- implicit real*8 (a-h,o-z)
-c
-c this function takes an angle (in radians) and puts it in the range of
-c -pi to +pi.
-c
- integer n
- include 'COMMON.GEO'
- n = x / dwapi
- pinorm = x - n * dwapi
- if ( pinorm .gt. pi ) then
- pinorm = pinorm - dwapi
- else if ( pinorm .lt. - pi ) then
- pinorm = pinorm + dwapi
- end if
- return
- end
+++ /dev/null
- subroutine printmat(ldim,m,n,iout,key,a)
- character*3 key(n)
- double precision a(ldim,n)
- do 1 i=1,n,8
- nlim=min0(i+7,n)
- write (iout,1000) (key(k),k=i,nlim)
- write (iout,1020)
- 1000 format (/5x,8(6x,a3))
- 1020 format (/80(1h-)/)
- do 2 j=1,n
- write (iout,1010) key(j),(a(j,k),k=i,nlim)
- 2 continue
- 1 continue
- 1010 format (a3,2x,8(f9.4))
- return
- end
+++ /dev/null
- real*8 function prng_next(me)
- implicit none
- integer me
-c
-c Calling sequence:
-c <new random number> = prng_next ( <ordinal of generator desired> )
-c <vector of random #s> = vprng ( <ordinal>, <vector>, <length> )
-c
-c This code is based on a sequential algorithm provided by Mal Kalos.
-c This version uses a single 64-bit word to store the initial seeds
-c and additive constants.
-c A 64-bit floating point number is returned.
-c
-c The array "iparam" is full-word aligned, being padded by zeros to
-c let each generator be on a subpage boundary.
-c That is, rows 1 and 2 in a given column of the array are for real,
-c rows 3-16 are bogus.
-c
-c July 12, 1993: double the number of sequences. We should have been
-c using two packets per seed, rather than four
-c October 31, 1993: merge the two arrays of seeds and constants,
-c and switch to 64-bit arithmetic.
-c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers
-c The ishft function is defined only on 32-bit integers, so we will
-c shift numbers by dividing by 2**11 and then adding on 2**53-1.
-c
-c November 1994: ishift now works on 64-bit numbers (though it gives a
-c warning). Thus we go back to using it. John Zollweg also added the
-c vprng() routine to return vectors of real*8 random numbers.
-c
- real*8 recip53
- parameter ( recip53 = 2.0D0**(-53) )
- integer*8 two
- parameter ( two = 2**11)
- integer*8 m,ishift
-c parameter ( m = 34522712143931 ) ! 11**13
-c parameter ( ishift = 9007199254740991 ) ! 2**53-1
-
- integer nmax
- integer*8 iparam
- parameter(nmax=1021)
- common/ksrprng/iparam(2,0:nmax)
-
- integer*8 next
-
-crc g77 doesn't support integer*8 constants
- m = dint(34522712143931.0d0)
- ishift = dint(9007199254740991.0d0)
-
-c RS6K porting note: ishift now takes 64-bit integers , with a warning
- if ( 0.le.me .and. me.le.nmax ) then
- next = iparam(1,me)*m + iparam(2,me)
- iparam(1,me) = next
- prng_next = recip53 * ishft( next, -11 )
- else
- prng_next=-1.0D0
- endif
-
- end
-c
-c vprng(me, rn, num) Get a vector of random numbers
-c
- subroutine vprng(me,rn,num)
- real*8 recip53, rn(1)
- parameter ( recip53 = 2.0D0**(-53) )
- integer*8 m,iparam
-c parameter ( m = 34522712143931 ) ! 11**13
- integer nmax, num, me
- parameter(nmax=1021)
- common/ksrprng/iparam(2,0:nmax)
-
- integer*8 next
-
-crc g77 doesn't support integer*8 constants
- m = dint(34522712143931.0d0)
-
- if ( 0.le.me .and. me.le.nmax ) then
- do 1 i=1,num
- next = iparam(1,me)*m + iparam(2,me)
- iparam(1,me) = next
- rn(i) = recip53 * ishft( next, -11 )
- 1 continue
- else
- rn(1)=-1.0D0
- endif
- return
- end
-
-c
-c prng_chkpnt Get the current state of a generator
-c
-c Calling sequence:
-c logical prng_chkpnt, status
-c status = prng_chkpnt (me, iseed) where
-c
-c me is the particular generator whose state is being gotten
-c seed is an 4-element integer array where the "l"-values will be saved
-c
- logical function prng_chkpnt (me, iseed)
- implicit none
- integer me
- integer*8 iseed
-
- integer nmax
- integer*8 iparam
- parameter(nmax=1021)
- common/ksrprng/iparam(2,0:nmax)
-
- if (me .lt. 0 .or. me .gt. nmax) then
- prng_chkpnt=.false.
- else
- prng_chkpnt=.true.
- iseed=iparam(1,me)
- endif
- end
-c
-c prng_restart Restart generator from a saved state
-c
-c Calling sequence:
-c logical prng_restart, status
-c status = prng_restart (me, iseed) where
-c
-c me is the particular generator being restarted
-c iseed is a 8-byte integer containing the "l"-values
-c
- logical function prng_restart (me, iseed)
- implicit none
- integer me
- integer*8 iseed
-
- integer nmax
- integer*8 iparam
- parameter(nmax=1021)
- common/ksrprng/iparam(2,0:nmax)
-
- if (me .lt. 0 .or. me .gt. nmax) then
- prng_restart=.false.
- return
- else
- prng_restart=.true.
- iparam(1,me)=iseed
- endif
- end
-
- block data prngblk
- parameter(nmax=1021)
- integer*8 iparam
- common/ksrprng/iparam(2,0:nmax)
- data (iparam(1,i),iparam(2,i),i= 0, 29) /
- + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241,
- + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271,
- + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339,
- + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363,
- + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379,
- + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451,
- + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489,
- + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523,
- + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553,
- + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 /
- data (iparam(1,i),iparam(2,i),i= 30, 59) /
- + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663,
- + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691,
- + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717,
- + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741,
- + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787,
- + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853,
- + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873,
- + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919,
- + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961,
- + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 /
- data (iparam(1,i),iparam(2,i),i= 60, 89) /
- + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069,
- + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093,
- + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129,
- + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183,
- + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237,
- + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251,
- + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291,
- + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339,
- + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399,
- + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 /
- data (iparam(1,i),iparam(2,i),i= 90, 119) /
- + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473,
- + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507,
- + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569,
- + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599,
- + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653,
- + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683,
- + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699,
- + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713,
- + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743,
- + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 /
- data (iparam(1,i),iparam(2,i),i= 120, 149) /
- + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809,
- + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881,
- + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923,
- + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987,
- + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019,
- + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049,
- + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077,
- + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121,
- + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149,
- + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 /
- data (iparam(1,i),iparam(2,i),i= 150, 179) /
- + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259,
- + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301,
- + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367,
- + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389,
- + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437,
- + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511,
- + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557,
- + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667,
- + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701,
- + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 /
- data (iparam(1,i),iparam(2,i),i= 180, 209) /
- + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829,
- + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877,
- + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913,
- + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941,
- + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961,
- + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997,
- + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051,
- + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093,
- + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127,
- + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 /
- data (iparam(1,i),iparam(2,i),i= 210, 239) /
- + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219,
- + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309,
- + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349,
- + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373,
- + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423,
- + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481,
- + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523,
- + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549,
- + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589,
- + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 /
- data (iparam(1,i),iparam(2,i),i= 240, 269) /
- + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621,
- + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673,
- + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753,
- + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793,
- + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841,
- + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891,
- + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927,
- + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967,
- + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051,
- + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 /
- data (iparam(1,i),iparam(2,i),i= 270, 299) /
- + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147,
- + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171,
- + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221,
- + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263,
- + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287,
- + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303,
- + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339,
- + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369,
- + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459,
- + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 /
- data (iparam(1,i),iparam(2,i),i= 300, 329) /
- + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557,
- + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591,
- + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623,
- + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657,
- + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719,
- + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767,
- + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807,
- + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833,
- + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873,
- + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 /
- data (iparam(1,i),iparam(2,i),i= 330, 359) /
- + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959,
- + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989,
- + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019,
- + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133,
- + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181,
- + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221,
- + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307,
- + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329,
- + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419,
- + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 /
- data (iparam(1,i),iparam(2,i),i= 360, 389) /
- + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529,
- + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601,
- + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629,
- + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679,
- + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731,
- + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773,
- + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839,
- + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869,
- + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889,
- + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 /
- data (iparam(1,i),iparam(2,i),i= 390, 419) /
- + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979,
- + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009,
- + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061,
- + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163,
- + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247,
- + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279,
- + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331,
- + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379,
- + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429,
- + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 /
- data (iparam(1,i),iparam(2,i),i= 420, 449) /
- + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489,
- + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523,
- + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571,
- + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607,
- + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709,
- + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783,
- + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847,
- + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877,
- + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897,
- + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 /
- data (iparam(1,i),iparam(2,i),i= 450, 479) /
- + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979,
- + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023,
- + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111,
- + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149,
- + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203,
- + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231,
- + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303,
- + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329,
- + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353,
- + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 /
- data (iparam(1,i),iparam(2,i),i= 480, 509) /
- + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399,
- + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489,
- + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521,
- + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551,
- + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587,
- + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653,
- + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689,
- + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731,
- + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747,
- + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 /
- data (iparam(1,i),iparam(2,i),i= 510, 539) /
- + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827,
- + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881,
- + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933,
- + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993,
- + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023,
- + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101,
- + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139,
- + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179,
- + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223,
- + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 /
- data (iparam(1,i),iparam(2,i),i= 540, 569) /
- + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307,
- + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343,
- + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373,
- + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461,
- + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479,
- + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541,
- + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583,
- + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653,
- + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697,
- + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 /
- data (iparam(1,i),iparam(2,i),i= 570, 599) /
- + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811,
- + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857,
- + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899,
- + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953,
- + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033,
- + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049,
- + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073,
- + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093,
- + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127,
- + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 /
- data (iparam(1,i),iparam(2,i),i= 600, 629) /
- + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243,
- + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277,
- + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309,
- + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333,
- + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369,
- + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409,
- + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451,
- + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477,
- + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499,
- + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 /
- data (iparam(1,i),iparam(2,i),i= 630, 659) /
- + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589,
- + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621,
- + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693,
- + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711,
- + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759,
- + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787,
- + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817,
- + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837,
- + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883,
- + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 /
- data (iparam(1,i),iparam(2,i),i= 660, 689) /
- + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991,
- + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017,
- + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039,
- + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059,
- + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131,
- + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177,
- + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227,
- + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269,
- + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291,
- + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 /
- data (iparam(1,i),iparam(2,i),i= 690, 719) /
- + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387,
- + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447,
- + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543,
- + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569,
- + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597,
- + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657,
- + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701,
- + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729,
- + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783,
- + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 /
- data (iparam(1,i),iparam(2,i),i= 720, 749) /
- + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893,
- + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947,
- + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971,
- + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031,
- + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073,
- + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083,
- + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137,
- + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157,
- + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179,
- + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 /
- data (iparam(1,i),iparam(2,i),i= 750, 779) /
- + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269,
- + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311,
- + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371,
- + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427,
- + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457,
- + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481,
- + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503,
- + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541,
- + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571,
- + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 /
- data (iparam(1,i),iparam(2,i),i= 780, 809) /
- + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713,
- + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751,
- + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821,
- + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853,
- + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893,
- + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917,
- + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961,
- + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997,
- + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039,
- + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 /
- data (iparam(1,i),iparam(2,i),i= 810, 839) /
- + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109,
- + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151,
- + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223,
- + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267,
- + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327,
- + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411,
- + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483,
- + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493,
- + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567,
- + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 /
- data (iparam(1,i),iparam(2,i),i= 840, 869) /
- + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643,
- + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669,
- + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697,
- + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727,
- + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777,
- + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811,
- + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867,
- + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963,
- + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993,
- + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 /
- data (iparam(1,i),iparam(2,i),i= 870, 899) /
- + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093,
- + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131,
- + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167,
- + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207,
- + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231,
- + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293,
- + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327,
- + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363,
- + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407,
- + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 /
- data (iparam(1,i),iparam(2,i),i= 900, 929) /
- + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527,
- + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557,
- + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579,
- + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611,
- + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639,
- + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671,
- + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693,
- + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713,
- + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803,
- + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 /
- data (iparam(1,i),iparam(2,i),i= 930, 959) /
- + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887,
- + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921,
- + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959,
- + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013,
- + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049,
- + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157,
- + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203,
- + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229,
- + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241,
- + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 /
- data (iparam(1,i),iparam(2,i),i= 960, 989) /
- + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313,
- + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353,
- + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439,
- + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527,
- + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569,
- + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611,
- + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673,
- + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703,
- + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791,
- + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 /
- data (iparam(1,i),iparam(2,i),i= 990,1019) /
- + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881,
- + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959,
- + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997,
- + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037,
- + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067,
- + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109,
- + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133,
- + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171,
- + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213,
- + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 /
- data (iparam(1,i),iparam(2,i),i=1020,1021) /
- + 11863259, 11863259, 11863279, 11863279 /
- end
+++ /dev/null
-#if defined(AIX) || defined(AMD64)
- real*8 function prng_next(mel)
- implicit none
- integer me,mel
-c
-c Calling sequence:
-c <new random number> = prng_next ( <ordinal of generator desired> )
-c <vector of random #s> = vprng ( <ordinal>, <vector>, <length> )
-c
-c This code is based on a sequential algorithm provided by Mal Kalos.
-c This version uses a single 64-bit word to store the initial seeds
-c and additive constants.
-c A 64-bit floating point number is returned.
-c
-c The array "iparam" is full-word aligned, being padded by zeros to
-c let each generator be on a subpage boundary.
-c That is, rows 1 and 2 in a given column of the array are for real,
-c rows 3-16 are bogus.
-c
-c July 12, 1993: double the number of sequences. We should have been
-c using two packets per seed, rather than four
-c October 31, 1993: merge the two arrays of seeds and constants,
-c and switch to 64-bit arithmetic.
-c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers
-c The ishft function is defined only on 32-bit integers, so we will
-c shift numbers by dividing by 2**11 and then adding on 2**53-1.
-c
-c November 1994: ishift now works on 64-bit numbers (though it gives a
-c warning). Thus we go back to using it. John Zollweg also added the
-c vprng() routine to return vectors of real*8 random numbers.
-c
- real*8 recip53
- parameter ( recip53 = 2.0D0**(-53) )
- integer*8 two
- parameter ( two = 2**11)
- integer*8 m,ishift
-c parameter ( m = 34522712143931 ) ! 11**13
-c parameter ( ishift = 9007199254740991 ) ! 2**53-1
-
- integer nmax
- integer*8 iparam
- parameter(nmax=1021)
- common/ksrprng/iparam(2,0:nmax)
-
- integer*8 next
-
-crc g77 doesn't support integer*8 constants
- m = dint(34522712143931.0d0)
- ishift = dint(9007199254740991.0d0)
- if(mel.gt.nmax) then
- me=mod(mel,nmax)
- else
- me=mel
- endif
-c RS6K porting note: ishift now takes 64-bit integers , with a warning
- if ( 0.le.me .and. me.le.nmax ) then
- next = iparam(1,me)*m + iparam(2,me)
- iparam(1,me) = next
- prng_next = recip53 * ishft( next, -11 )
- else
- prng_next=-1.0D0
- endif
-
- end
-c
-c vprng(me, rn, num) Get a vector of random numbers
-c
- subroutine vprng(me,rn,num)
- real*8 recip53, rn(1)
- parameter ( recip53 = 2.0D0**(-53) )
- integer*8 m,iparam
-c parameter ( m = 34522712143931 ) ! 11**13
- integer nmax, num, me
- parameter(nmax=1021)
- common/ksrprng/iparam(2,0:nmax)
-
- integer*8 next
-
-crc g77 doesn't support integer*8 constants
- m = dint(34522712143931.0d0)
-
- if ( 0.le.me .and. me.le.nmax ) then
- do 1 i=1,num
- next = iparam(1,me)*m + iparam(2,me)
- iparam(1,me) = next
- rn(i) = recip53 * ishft( next, -11 )
- 1 continue
- else
- rn(1)=-1.0D0
- endif
- return
- end
-
-c
-c prng_chkpnt Get the current state of a generator
-c
-c Calling sequence:
-c logical prng_chkpnt, status
-c status = prng_chkpnt (me, iseed) where
-c
-c me is the particular generator whose state is being gotten
-c seed is an 4-element integer array where the "l"-values will be saved
-c
- logical function prng_chkpnt (me, iseed)
- implicit none
- integer me
- integer*8 iseed
-
- integer nmax
- integer*8 iparam
- parameter(nmax=1021)
- common/ksrprng/iparam(2,0:nmax)
-
- if (me .lt. 0 .or. me .gt. nmax) then
- prng_chkpnt=.false.
- else
- prng_chkpnt=.true.
- iseed=iparam(1,me)
- endif
- end
-c
-c prng_restart Restart generator from a saved state
-c
-c Calling sequence:
-c logical prng_restart, status
-c status = prng_restart (me, iseed) where
-c
-c me is the particular generator being restarted
-c iseed is a 8-byte integer containing the "l"-values
-c
- logical function prng_restart (mel, iseed)
- implicit none
- integer me,mel
- integer*8 iseed
-
- integer nmax
- integer*8 iparam
- parameter(nmax=1021)
- common/ksrprng/iparam(2,0:nmax)
-
- if(mel.gt.nmax) then
- me=mod(mel,nmax)
- else
- me=mel
- endif
- if (me .lt. 0 .or. me .gt. nmax) then
- prng_restart=.false.
- return
- else
- prng_restart=.true.
- iparam(1,me)=iseed
- endif
- end
-
- block data prngblk
- parameter(nmax=1021)
- integer*8 iparam
- common/ksrprng/iparam(2,0:nmax)
- data (iparam(1,i),iparam(2,i),i= 0, 29) /
- + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241,
- + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271,
- + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339,
- + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363,
- + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379,
- + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451,
- + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489,
- + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523,
- + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553,
- + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 /
- data (iparam(1,i),iparam(2,i),i= 30, 59) /
- + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663,
- + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691,
- + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717,
- + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741,
- + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787,
- + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853,
- + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873,
- + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919,
- + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961,
- + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 /
- data (iparam(1,i),iparam(2,i),i= 60, 89) /
- + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069,
- + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093,
- + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129,
- + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183,
- + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237,
- + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251,
- + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291,
- + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339,
- + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399,
- + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 /
- data (iparam(1,i),iparam(2,i),i= 90, 119) /
- + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473,
- + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507,
- + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569,
- + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599,
- + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653,
- + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683,
- + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699,
- + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713,
- + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743,
- + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 /
- data (iparam(1,i),iparam(2,i),i= 120, 149) /
- + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809,
- + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881,
- + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923,
- + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987,
- + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019,
- + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049,
- + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077,
- + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121,
- + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149,
- + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 /
- data (iparam(1,i),iparam(2,i),i= 150, 179) /
- + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259,
- + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301,
- + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367,
- + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389,
- + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437,
- + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511,
- + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557,
- + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667,
- + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701,
- + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 /
- data (iparam(1,i),iparam(2,i),i= 180, 209) /
- + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829,
- + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877,
- + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913,
- + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941,
- + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961,
- + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997,
- + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051,
- + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093,
- + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127,
- + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 /
- data (iparam(1,i),iparam(2,i),i= 210, 239) /
- + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219,
- + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309,
- + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349,
- + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373,
- + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423,
- + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481,
- + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523,
- + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549,
- + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589,
- + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 /
- data (iparam(1,i),iparam(2,i),i= 240, 269) /
- + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621,
- + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673,
- + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753,
- + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793,
- + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841,
- + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891,
- + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927,
- + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967,
- + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051,
- + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 /
- data (iparam(1,i),iparam(2,i),i= 270, 299) /
- + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147,
- + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171,
- + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221,
- + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263,
- + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287,
- + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303,
- + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339,
- + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369,
- + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459,
- + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 /
- data (iparam(1,i),iparam(2,i),i= 300, 329) /
- + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557,
- + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591,
- + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623,
- + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657,
- + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719,
- + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767,
- + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807,
- + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833,
- + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873,
- + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 /
- data (iparam(1,i),iparam(2,i),i= 330, 359) /
- + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959,
- + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989,
- + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019,
- + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133,
- + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181,
- + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221,
- + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307,
- + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329,
- + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419,
- + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 /
- data (iparam(1,i),iparam(2,i),i= 360, 389) /
- + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529,
- + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601,
- + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629,
- + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679,
- + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731,
- + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773,
- + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839,
- + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869,
- + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889,
- + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 /
- data (iparam(1,i),iparam(2,i),i= 390, 419) /
- + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979,
- + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009,
- + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061,
- + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163,
- + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247,
- + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279,
- + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331,
- + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379,
- + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429,
- + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 /
- data (iparam(1,i),iparam(2,i),i= 420, 449) /
- + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489,
- + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523,
- + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571,
- + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607,
- + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709,
- + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783,
- + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847,
- + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877,
- + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897,
- + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 /
- data (iparam(1,i),iparam(2,i),i= 450, 479) /
- + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979,
- + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023,
- + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111,
- + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149,
- + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203,
- + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231,
- + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303,
- + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329,
- + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353,
- + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 /
- data (iparam(1,i),iparam(2,i),i= 480, 509) /
- + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399,
- + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489,
- + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521,
- + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551,
- + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587,
- + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653,
- + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689,
- + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731,
- + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747,
- + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 /
- data (iparam(1,i),iparam(2,i),i= 510, 539) /
- + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827,
- + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881,
- + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933,
- + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993,
- + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023,
- + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101,
- + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139,
- + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179,
- + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223,
- + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 /
- data (iparam(1,i),iparam(2,i),i= 540, 569) /
- + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307,
- + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343,
- + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373,
- + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461,
- + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479,
- + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541,
- + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583,
- + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653,
- + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697,
- + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 /
- data (iparam(1,i),iparam(2,i),i= 570, 599) /
- + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811,
- + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857,
- + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899,
- + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953,
- + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033,
- + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049,
- + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073,
- + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093,
- + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127,
- + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 /
- data (iparam(1,i),iparam(2,i),i= 600, 629) /
- + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243,
- + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277,
- + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309,
- + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333,
- + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369,
- + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409,
- + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451,
- + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477,
- + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499,
- + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 /
- data (iparam(1,i),iparam(2,i),i= 630, 659) /
- + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589,
- + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621,
- + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693,
- + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711,
- + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759,
- + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787,
- + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817,
- + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837,
- + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883,
- + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 /
- data (iparam(1,i),iparam(2,i),i= 660, 689) /
- + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991,
- + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017,
- + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039,
- + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059,
- + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131,
- + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177,
- + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227,
- + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269,
- + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291,
- + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 /
- data (iparam(1,i),iparam(2,i),i= 690, 719) /
- + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387,
- + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447,
- + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543,
- + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569,
- + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597,
- + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657,
- + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701,
- + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729,
- + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783,
- + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 /
- data (iparam(1,i),iparam(2,i),i= 720, 749) /
- + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893,
- + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947,
- + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971,
- + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031,
- + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073,
- + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083,
- + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137,
- + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157,
- + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179,
- + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 /
- data (iparam(1,i),iparam(2,i),i= 750, 779) /
- + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269,
- + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311,
- + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371,
- + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427,
- + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457,
- + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481,
- + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503,
- + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541,
- + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571,
- + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 /
- data (iparam(1,i),iparam(2,i),i= 780, 809) /
- + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713,
- + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751,
- + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821,
- + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853,
- + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893,
- + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917,
- + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961,
- + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997,
- + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039,
- + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 /
- data (iparam(1,i),iparam(2,i),i= 810, 839) /
- + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109,
- + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151,
- + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223,
- + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267,
- + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327,
- + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411,
- + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483,
- + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493,
- + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567,
- + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 /
- data (iparam(1,i),iparam(2,i),i= 840, 869) /
- + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643,
- + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669,
- + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697,
- + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727,
- + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777,
- + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811,
- + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867,
- + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963,
- + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993,
- + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 /
- data (iparam(1,i),iparam(2,i),i= 870, 899) /
- + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093,
- + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131,
- + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167,
- + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207,
- + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231,
- + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293,
- + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327,
- + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363,
- + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407,
- + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 /
- data (iparam(1,i),iparam(2,i),i= 900, 929) /
- + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527,
- + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557,
- + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579,
- + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611,
- + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639,
- + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671,
- + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693,
- + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713,
- + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803,
- + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 /
- data (iparam(1,i),iparam(2,i),i= 930, 959) /
- + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887,
- + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921,
- + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959,
- + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013,
- + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049,
- + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157,
- + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203,
- + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229,
- + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241,
- + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 /
- data (iparam(1,i),iparam(2,i),i= 960, 989) /
- + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313,
- + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353,
- + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439,
- + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527,
- + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569,
- + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611,
- + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673,
- + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703,
- + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791,
- + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 /
- data (iparam(1,i),iparam(2,i),i= 990,1019) /
- + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881,
- + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959,
- + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997,
- + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037,
- + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067,
- + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109,
- + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133,
- + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171,
- + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213,
- + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 /
- data (iparam(1,i),iparam(2,i),i=1020,1021) /
- + 11863259, 11863259, 11863279, 11863279 /
- end
-#else
- real function prng_next(me)
-crc logical prng_restart, prng_chkpnt
-c
-c Calling sequence:
-c <new random number> = prng_next ( <ordinal of generator desired> )
-c
-c This code is based on a sequential algorithm provided by Mal Kalos.
-c This version uses 4 16-bit packets, and uses a block data common
-c area for the initial seeds and constants. A 64-bit floating point
-c number is returned.
-c
-c The arrays "l" and "n" are full-word aligned, being padded by zeros
-c That is, rows 1-4 in a given column are for real, rows 5-16 are bogus
-c
-c July 12, 1993: double the number of sequences. We should have been
-c using two packets per seed, rather than four
-c
- real tpm12
- integer iseed(4)
- parameter(tpm12 = 1.d0/65536.d0)
- parameter(nmax=1021)
-c external prngblk
- common/ksrprng/l(16,0:nmax),n(16,0:nmax)
-c*ksr*subpage /ksrprng/
- data m1,m2,m3,m4 / 0, 8037, 61950, 30779/
- if (me .lt. 0 .or. me .gt. nmax) then
- prng_next=-1.0
- return
- endif
- l1=l(1,me)
- l2=l(2,me)
- l3=l(3,me)
- l4=l(4,me)
- i1=l1*m4+l2*m3+l3*m2+l4*m1 + n(1,me)
- i2=l2*m4+l3*m3+l4*m2 + n(2,me)
- i3=l3*m4+l4*m3 + n(3,me)
- i4=l4*m4 + n(4,me)
- l4=and(i4,65535)
- i3=i3+ishft(i4,-16)
- l3=and(i3,65535)
- i2=i2+ishft(i3,-16)
- l2=and(i2,65535)
- l1=and(i1+ishft(i2,-16),65535)
- prng_next=tpm12*(l1+tpm12*(l2+tpm12*(l3+tpm12*l4)))
- l(1,me)=l1
- l(2,me)=l2
- l(3,me)=l3
- l(4,me)=l4
- return
- end
-c
-c prng_chkpnt Get the current state of a generator
-c
-c Calling sequence:
-c logical prng_chkpnt, status
-c status = prng_chkpnt (me, iseed) where
-c
-c me is the particular generator whose state is being gotten
-c seed is an 4-element integer array where the "l"-values will be saved
-c
-crc entry prng_chkpnt (me, iseed)
- logical function prng_chkpnt (me, iseed)
- integer iseed(4)
- parameter(nmax=1021)
- common/ksrprng/l(16,0:nmax),n(16,0:nmax)
- if (me .lt. 0 .or. me .gt. nmax) then
- prng_chkpnt=.false.
- else
- prng_chkpnt=.true.
- iseed(1)=l(1,me)
- iseed(2)=l(2,me)
- iseed(3)=l(3,me)
- iseed(4)=l(4,me)
- endif
- return
- end
-c
-c prng_restart Restart generator from a saved state
-c
-c Calling sequence:
-c logical prng_restart, status
-c status = prng_restart (me, iseed) where
-c
-c me is the particular generator being restarted
-c seed is an 4-element integer array containing the "l"-values
-c
-crc entry prng_restart (me, iseed)
- logical function prng_restart (me, iseed)
- integer iseed(4)
- parameter(nmax=1021)
- common/ksrprng/l(16,0:nmax),n(16,0:nmax)
- if (me .lt. 0 .or. me .gt. nmax) then
- prng_restart=.false.
- return
- else
- prng_restart=.true.
- l(1,me)=iseed(1)
- l(2,me)=iseed(2)
- l(3,me)=iseed(3)
- l(4,me)=iseed(4)
- endif
- return
- end
-
- block data prngblk
-c
-c Sequence of prime numbers represented as pairs of 16-bit integers
-c modulo 2**16, obtained from Mal Kalos August 28, 1992. Only 98
-c continuation cards are allowed by ksr Fortran, so several DATA
-c statements are used to initialize 1022 generators.
-c
-c @cornell university, 1992
-c
- parameter(nmax=1021,nmax1=2*nmax+2)
- common/ksrprng/l(16,0:nmax),n(16,0:nmax)
-c*ksr*subpage /ksrprng/
-
-c High order quads in arrays "l" and "n" are initialized to zero : rows 1-2
-c Rows 5-16 remain uninitialized. They are just pads, never used.
- DATA ((l(i,j),i=1,2),j=0,nmax)/nmax1*0.0/
- DATA ((n(i,j),i=1,2),j=0,nmax)/nmax1*0.0/
-
-c The rest of array "l" and "n" are initialized to a 20-bit seed
- DATA ((l(i,j),i=3,4),j=0,489)/
- .180, 51739,180, 51757,180, 51761,180, 51767,180,51773,
- .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871,
- .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899,
- .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997,
- .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051,
- .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121,
- .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199,
- .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241,
- .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307,
- .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387,
- .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451,
- .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559,
- .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607,
- .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657,
- .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757,
- .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793,
- .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879,
- .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937,
- .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023,
- .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093,
- .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173,
- .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213,
- .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243,
- .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291,
- .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389,
- .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453,
- .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539,
- .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593,
- .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647,
- .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711,
- .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803,
- .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893,
- .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957,
- .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061,
- .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197,
- .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269,
- .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379,
- .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439,
- .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481,
- .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553,
- .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629,
- .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683,
- .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823,
- .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871,
- .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943,
- .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039,
- .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079,
- .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123,
- .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159,
- .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279,
- .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361,
- .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439,
- .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517,
- .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603,
- .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681,
- .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757,
- .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807,
- .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847,
- .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957,
- .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051,
- .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099,
- .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161,
- .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239,
- .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323,
- .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357,
- .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437,
- .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503,
- .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551,
- .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701,
- .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761,
- .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887,
- .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969,
- .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091,
- .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169,
- .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251,
- .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337,
- .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403,
- .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431,
- .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521,
- .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667,
- .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767,
- .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847,
- .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919,
- .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961,
- .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039,
- .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093,
- .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229,
- .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333,
- .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403,
- .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457,
- .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537,
- .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661,
- .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723,
- .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789,
- .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859,
- .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901,
- .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933,
- .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/
- DATA ((l(i,j),i=3,4),j=490,979)/
- .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107,
- .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207,
- .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257,
- .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321,
- .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389,
- .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479,
- .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543,
- .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633,
- .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713,
- .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789,
- .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849,
- .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929,
- .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999,
- .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073,
- .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179,
- .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251,
- .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361,
- .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439,
- .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553,
- .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587,
- .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619,
- .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713,
- .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787,
- .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847,
- .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889,
- .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943,
- .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001,
- .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049,
- .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133,
- .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217,
- .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279,
- .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321,
- .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393,
- .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433,
- .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529,
- .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571,
- .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651,
- .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721,
- .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799,
- .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879,
- .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963,
- .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071,
- .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117,
- .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203,
- .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267,
- .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333,
- .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441,
- .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509,
- .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593,
- .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629,
- .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683,
- .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753,
- .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827,
- .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897,
- .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977,
- .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013,
- .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083,
- .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131,
- .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259,
- .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353,
- .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413,
- .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449,
- .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541,
- .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607,
- .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653,
- .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751,
- .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847,
- .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997,
- .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037,
- .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139,
- .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181,
- .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219,
- .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297,
- .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379,
- .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489,
- .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591,
- .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627,
- .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711,
- .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751,
- .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823,
- .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891,
- .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949,
- .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063,
- .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101,
- .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159,
- .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207,
- .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269,
- .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369,
- .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437,
- .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507,
- .180, 65527,180, 65533,181, 13,181, 15,181, 33,
- .181, 61,181, 67,181, 141,181, 151,181, 183,
- .181, 187,181, 201,181, 207,181, 213,181, 217,
- .181, 223,181, 225,181, 243,181, 253,181, 255,
- .181, 277,181, 291,181, 297,181, 301,181, 327,
- .181, 337,181, 357,181, 375,181, 423,181, 453,
- .181, 477,181, 511,181, 531,181, 547,181, 553,
- .181, 561,181, 565,181, 595,181, 607,181, 645/
- DATA ((l(i,j),i=3,4),j=980,nmax)/
- .181, 657,181, 663,181, 685,181, 687,181, 697,
- .181, 745,181, 775,181, 787,181, 823,181, 825,
- .181, 841,181, 853,181, 865,181, 895,181, 903,
- .181, 943,181, 963,181, 973,181, 981,181, 1005,
- .181,1015,181,1021,181,1023,181,1041,181,1051,
- .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107,
- .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167,
- .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237,
- .181, 1243,181, 1263/
- DATA ((n(i,j),i=3,4),j=0,489)/
- .180, 51739,180, 51757,180, 51761,180, 51767,180, 51773,
- .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871,
- .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899,
- .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997,
- .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051,
- .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121,
- .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199,
- .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241,
- .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307,
- .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387,
- .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451,
- .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559,
- .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607,
- .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657,
- .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757,
- .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793,
- .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879,
- .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937,
- .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023,
- .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093,
- .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173,
- .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213,
- .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243,
- .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291,
- .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389,
- .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453,
- .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539,
- .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593,
- .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647,
- .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711,
- .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803,
- .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893,
- .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957,
- .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061,
- .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197,
- .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269,
- .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379,
- .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439,
- .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481,
- .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553,
- .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629,
- .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683,
- .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823,
- .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871,
- .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943,
- .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039,
- .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079,
- .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123,
- .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159,
- .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279,
- .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361,
- .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439,
- .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517,
- .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603,
- .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681,
- .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757,
- .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807,
- .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847,
- .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957,
- .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051,
- .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099,
- .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161,
- .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239,
- .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323,
- .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357,
- .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437,
- .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503,
- .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551,
- .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701,
- .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761,
- .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887,
- .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969,
- .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091,
- .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169,
- .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251,
- .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337,
- .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403,
- .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431,
- .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521,
- .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667,
- .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767,
- .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847,
- .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919,
- .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961,
- .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039,
- .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093,
- .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229,
- .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333,
- .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403,
- .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457,
- .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537,
- .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661,
- .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723,
- .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789,
- .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859,
- .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901,
- .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933,
- .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/
- DATA ((n(i,j),i=3,4),j=490,979)/
- .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107,
- .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207,
- .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257,
- .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321,
- .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389,
- .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479,
- .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543,
- .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633,
- .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713,
- .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789,
- .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849,
- .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929,
- .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999,
- .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073,
- .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179,
- .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251,
- .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361,
- .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439,
- .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553,
- .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587,
- .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619,
- .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713,
- .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787,
- .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847,
- .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889,
- .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943,
- .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001,
- .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049,
- .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133,
- .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217,
- .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279,
- .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321,
- .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393,
- .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433,
- .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529,
- .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571,
- .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651,
- .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721,
- .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799,
- .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879,
- .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963,
- .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071,
- .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117,
- .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203,
- .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267,
- .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333,
- .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441,
- .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509,
- .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593,
- .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629,
- .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683,
- .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753,
- .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827,
- .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897,
- .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977,
- .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013,
- .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083,
- .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131,
- .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259,
- .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353,
- .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413,
- .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449,
- .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541,
- .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607,
- .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653,
- .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751,
- .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847,
- .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997,
- .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037,
- .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139,
- .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181,
- .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219,
- .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297,
- .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379,
- .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489,
- .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591,
- .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627,
- .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711,
- .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751,
- .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823,
- .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891,
- .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949,
- .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063,
- .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101,
- .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159,
- .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207,
- .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269,
- .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369,
- .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437,
- .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507,
- .180, 65527,180, 65533,181, 13,181, 15,181, 33,
- .181, 61,181, 67,181, 141,181, 151,181, 183,
- .181, 187,181, 201,181, 207,181, 213,181, 217,
- .181, 223,181, 225,181, 243,181, 253,181, 255,
- .181, 277,181, 291,181, 297,181, 301,181, 327,
- .181, 337,181, 357,181, 375,181, 423,181, 453,
- .181, 477,181, 511,181, 531,181, 547,181, 553,
- .181, 561,181, 565,181, 595,181, 607,181, 645/
- DATA ((n(i,j),i=3,4),j=980,nmax)/
- .181, 657,181, 663,181, 685,181, 687,181, 697,
- .181, 745,181, 775,181, 787,181, 823,181, 825,
- .181, 841,181, 853,181, 865,181, 895,181, 903,
- .181, 943,181, 963,181, 973,181, 981,181, 1005,
- .181, 1015,181, 1021,181, 1023,181, 1041,181, 1051,
- .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107,
- .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167,
- .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237,
- .181, 1243,181, 1263/
- end
-#endif
+++ /dev/null
-#include <stdlib.h>
-#include <math.h>
-
-#ifdef CRAY
-void PROC_PROC(long int *f, int *i)
-#else
-#ifdef LINUX
-#ifdef PGI
-void proc_proc_(long int *f, int *i)
-#else
-void proc_proc__(long int *f, int *i)
-#endif
-#endif
-#ifdef SGI
-void proc_proc_(long int *f, int *i)
-#endif
-#if defined(WIN) && !defined(WINIFL)
-void _stdcall PROC_PROC(long int *f, int *i)
-#endif
-#ifdef WINIFL
-void proc_proc(long int *f, int *i)
-#endif
-#if defined(AIX) || defined(WINPGI)
-void proc_proc(long int *f, int *i)
-#endif
-#endif
-
-{
-static long int NaNQ;
-static long int NaNQm;
-
-if(*i==-1)
- {
- NaNQ=*f;
- NaNQm=0xffffffff;
- return;
- }
-*i=0;
-if(*f==NaNQ)
- *i=1;
-if(*f==NaNQm)
- *i=1;
-}
-
-#ifdef CRAY
-void PROC_CONV(char *buf, int *i, int n)
-#endif
-#ifdef LINUX
-void proc_conv__(char *buf, int *i, int n)
-#endif
-#ifdef SGI
-void proc_conv_(char *buf, int *i, int n)
-#endif
-#if defined(AIX) || defined(WINPGI)
-void proc_conv(char *buf, int *i, int n)
-#endif
-#ifdef WIN
-void _stdcall PROC_CONV(char *buf, int *i, int n)
-#endif
-{
-int j;
-
-sscanf(buf,"%d",&j);
-*i=j;
-return;
-}
-
-#ifdef CRAY
-void PROC_CONV_R(char *buf, int *i, int n)
-#endif
-#ifdef LINUX
-void proc_conv_r__(char *buf, int *i, int n)
-#endif
-#ifdef SGI
-void proc_conv_r_(char *buf, int *i, int n)
-#endif
-#if defined(AIX) || defined(WINPGI)
-void proc_conv_r(char *buf, int *i, int n)
-#endif
-#ifdef WIN
-void _stdcall PROC_CONV_R(char *buf, int *i, int n)
-#endif
-
-{
-
-/* sprintf(buf,"%d",*i); */
-
-return;
-}
-
-
-#ifndef IMSL
-#ifdef CRAY
-void DSVRGP(int *n, double *tab1, double *tab2, int *itab)
-#endif
-#ifdef LINUX
-void dsvrgp__(int *n, double *tab1, double *tab2, int *itab)
-#endif
-#ifdef SGI
-void dsvrgp_(int *n, double *tab1, double *tab2, int *itab)
-#endif
-#if defined(AIX) || defined(WINPGI)
-void dsvrgp(int *n, double *tab1, double *tab2, int *itab)
-#endif
-#ifdef WIN
-void _stdcall DSVRGP(int *n, double *tab1, double *tab2, int *itab)
-#endif
-{
-double t;
-int i,j,k;
-
-if(tab1 != tab2)
- {
- for(i=0; i<*n; i++)
- tab2[i]=tab1[i];
- }
-k=0;
-while(k<*n-1)
- {
- j=k;
- t=tab2[k];
- for(i=k+1; i<*n; i++)
- if(t>tab2[i])
- {
- j=i;
- t=tab2[i];
- }
- if(j!=k)
- {
- tab2[j]=tab2[k];
- tab2[k]=t;
- i=itab[j];
- itab[j]=itab[k];
- itab[k]=i;
- }
- k++;
- }
-}
-#endif
+++ /dev/null
- double precision function qwolynes(seg1,seg2,flag,seg3,seg4)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- integer i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,
- & secseg
- integer nsep /3/
- double precision dist,qm
- double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM
- logical lprn /.false./
- logical flag
- double precision sigm,x
- sigm(x)=0.25d0*x
- qq = 0.0d0
- nl=0
- if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
- nl=nl+1
- d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+
- & (cref(2,jl)-cref(2,il))**2+
- & (cref(3,jl)-cref(3,il))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il).ne.10 .or. itype(jl).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt(
- & (cref(1,jl+nres)-cref(1,il+nres))**2+
- & (cref(2,jl+nres)-cref(2,il+nres))**2+
- & (cref(3,jl+nres)-cref(3,il+nres))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
- enddo
- qq = qq/nl
- else
- do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
- nl=nl+1
- d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+
- & (cref(2,jl)-cref(2,il))**2+
- & (cref(3,jl)-cref(3,il))**2)
- dij=dist(il,jl)
- qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
- if (itype(il).ne.10 .or. itype(jl).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt(
- & (cref(1,jl+nres)-cref(1,il+nres))**2+
- & (cref(2,jl+nres)-cref(2,il+nres))**2+
- & (cref(3,jl+nres)-cref(3,il+nres))**2)
- dijCM=dist(il+nres,jl+nres)
- qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
- endif
- qq = qq+qqij+qqijCM
- enddo
- enddo
- qq = qq/nl
- endif
- qwolynes=1.0d0-qq
- return
- end
-c-------------------------------------------------------------------
- subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- integer i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,
- & secseg
- integer nsep /3/
- double precision dist
- double precision dij,d0ij,dijCM,d0ijCM
- logical lprn /.false./
- logical flag
- double precision sigm,x,sim,dd0,fac,ddqij
- sigm(x)=0.25d0*x
-
- do i=0,nres
- do j=1,3
- dqwol(j,i)=0.0d0
- dxqwol(j,i)=0.0d0
- enddo
- enddo
- nl=0
- if(flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
- nl=nl+1
- d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+
- & (cref(2,jl)-cref(2,il))**2+
- & (cref(3,jl)-cref(3,il))**2)
- dij=dist(il,jl)
- sim = 1.0d0/sigm(d0ij)
- sim = sim*sim
- dd0 = dij-d0ij
- fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
- enddo
-
- if (itype(il).ne.10 .or. itype(jl).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt(
- & (cref(1,jl+nres)-cref(1,il+nres))**2+
- & (cref(2,jl+nres)-cref(2,il+nres))**2+
- & (cref(3,jl+nres)-cref(3,il+nres))**2)
- dijCM=dist(il+nres,jl+nres)
- sim = 1.0d0/sigm(d0ijCM)
- sim = sim*sim
- dd0=dijCM-d0ijCM
- fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
- enddo
- enddo
- else
- do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
- nl=nl+1
- d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+
- & (cref(2,jl)-cref(2,il))**2+
- & (cref(3,jl)-cref(3,il))**2)
- dij=dist(il,jl)
- sim = 1.0d0/sigm(d0ij)
- sim = sim*sim
- dd0 = dij-d0ij
- fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
- enddo
- if (itype(il).ne.10 .or. itype(jl).ne.10) then
- nl=nl+1
- d0ijCM=dsqrt(
- & (cref(1,jl+nres)-cref(1,il+nres))**2+
- & (cref(2,jl+nres)-cref(2,il+nres))**2+
- & (cref(3,jl+nres)-cref(3,il+nres))**2)
- dijCM=dist(il+nres,jl+nres)
- sim = 1.0d0/sigm(d0ijCM)
- sim=sim*sim
- dd0 = dijCM-d0ijCM
- fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
- do k=1,3
- ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
- enddo
- enddo
- endif
- do i=0,nres
- do j=1,3
- dqwol(j,i)=dqwol(j,i)/nl
- dxqwol(j,i)=dxqwol(j,i)/nl
- enddo
- enddo
- return
- end
-c-------------------------------------------------------------------
- subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- integer seg1,seg2,seg3,seg4
- logical flag
- double precision qwolan(3,0:maxres),cdummy(3,0:maxres2),
- & qwolxan(3,0:maxres),q1,q2
- double precision delta /1.0d-10/
- do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i)=c(j,i)
- c(j,i)=c(j,i)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolan(j,i)=(q2-q1)/delta
- c(j,i)=cdummy(j,i)
- enddo
- enddo
- do i=0,nres
- do j=1,3
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- cdummy(j,i+nres)=c(j,i+nres)
- c(j,i+nres)=c(j,i+nres)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolxan(j,i)=(q2-q1)/delta
- c(j,i+nres)=cdummy(j,i+nres)
- enddo
- enddo
-c write(iout,*) "Numerical Q carteisan gradients backbone: "
-c do i=0,nct
-c write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
-c enddo
-c write(iout,*) "Numerical Q carteisan gradients side-chain: "
-c do i=0,nct
-c write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
-c enddo
- return
- end
-c------------------------------------------------------------------------
- subroutine EconstrQ
-c MD with umbrella_sampling using Wolyne's distance measure as a constraint
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision uzap1,uzap2,hm1,hm2,hmnum
- double precision ucdelan,dUcartan(3,0:MAXRES)
- & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES),
- & duconst(3,0:MAXRES),duxconst(3,0:MAXRES)
- integer kstart,kend,lstart,lend,idummy
- double precision delta /1.0d-7/
- do i=0,nres
- do j=1,3
- duconst(j,i)=0.0d0
- dudconst(j,i)=0.0d0
- duxconst(j,i)=0.0d0
- dudxconst(j,i)=0.0d0
- enddo
- enddo
- Uconst=0.0d0
- do i=1,nfrag
- qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.
- & ,idummy,idummy)
- Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
-c Calculating the derivatives of Constraint energy with respect to Q
- Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),
- & qinfrag(i,iset))
-c hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
-c hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
-c hmnum=(hm2-hm1)/delta
-c write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
-c & qinfrag(i,iset))
-c write(iout,*) "harmonicnum frag", hmnum
-c Calculating the derivatives of Q with respect to cartesian coordinates
- call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.
- & ,idummy,idummy)
-c write(iout,*) "dqwol "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
-c enddo
-c write(iout,*) "dxqwol "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
-c enddo
-c Calculating numerical gradients of dU/dQi and dQi/dxi
-c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
-c & ,idummy,idummy)
-c The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
- enddo
- enddo
- enddo
- do i=1,npair
- kstart=ifrag(1,ipair(1,i,iset),iset)
- kend=ifrag(2,ipair(1,i,iset),iset)
- lstart=ifrag(1,ipair(2,i,iset),iset)
- lend=ifrag(2,ipair(2,i,iset),iset)
- qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
- Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
-c Calculating dU/dQ
- Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
-c hm1=harmonic(qpair(i),qinpair(i,iset))
-c hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
-c hmnum=(hm2-hm1)/delta
-c write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
-c & qinpair(i,iset))
-c write(iout,*) "harmonicnum pair ", hmnum
-c Calculating dQ/dXi
- call qwolynes_prim(kstart,kend,.false.
- & ,lstart,lend)
-c write(iout,*) "dqwol "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
-c enddo
-c write(iout,*) "dxqwol "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
-c enddo
-c Calculating numerical gradients
-c call qwol_num(kstart,kend,.false.
-c & ,lstart,lend)
-c The gradients of Uconst in Cs
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
- enddo
- enddo
- enddo
-c write(iout,*) "Uconst inside subroutine ", Uconst
-c Transforming the gradients from Cs to dCs for the backbone
- do i=0,nres
- do j=i+1,nres
- do k=1,3
- dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
- enddo
- enddo
- enddo
-c Transforming the gradients from Cs to dCs for the side chains
- do i=1,nres
- do j=1,3
- dudxconst(j,i)=duxconst(j,i)
- enddo
- enddo
-c write(iout,*) "dU/ddc backbone "
-c do ii=0,nres
-c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
-c enddo
-c write(iout,*) "dU/ddX side chain "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
-c enddo
-c Calculating numerical gradients of dUconst/ddc and dUconst/ddx
-c call dEconstrQ_num
- return
- end
-c-----------------------------------------------------------------------
- subroutine dEconstrQ_num
-c Calculating numerical dUconst/ddc and dUconst/ddx
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision uzap1,uzap2
- double precision dUcartan(3,0:MAXRES)
- & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES)
- integer kstart,kend,lstart,lend,idummy
- double precision delta /1.0d-7/
-c For the backbone
- do i=0,nres-1
- do j=1,3
- dUcartan(j,i)=0.0d0
- cdummy(j,i)=dc(j,i)
- dc(j,i)=dc(j,i)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.
- & ,idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),
- & qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),
- & qinpair(ii,iset))
- enddo
- dc(j,i)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.
- & ,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),
- & qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),
- & qinpair(ii,iset))
- enddo
- ducartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
-c Calculating numerical gradients for dU/ddx
- do i=0,nres-1
- duxcartan(j,i)=0.0d0
- do j=1,3
- cdummy(j,i)=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.
- & ,idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),
- & qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),
- & qinpair(ii,iset))
- enddo
- dc(j,i+nres)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),
- & ifrag(2,ii,iset),.true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),
- & qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),
- & qinpair(ii,iset))
- enddo
- duxcartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
- write(iout,*) "Numerical dUconst/ddc backbone "
- do ii=0,nres
- write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
- enddo
-c write(iout,*) "Numerical dUconst/ddx side-chain "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
-c enddo
- return
- end
-c---------------------------------------------------------------------------
+++ /dev/null
- double precision function qwolynes(seg1,seg2,flag,seg3,seg4)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- integer i,j,jl,k,l,il,kl,nl,np,seg1,seg2,seg3,seg4,secseg
- integer nsep /3/
- double precision dist,qm
- double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM
- logical lprn /.false./
- logical flag
- qq = 0.0d0
- nl=0
- do i=0,nres
- do j=1,3
- dqwol(j,i)=0.0d0
- dxqwol(j,i)=0.0d0
- enddo
- enddo
- if (lprn) then
- write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4,
- & " flag",flag
- call flush(iout)
- endif
- if (flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
- nl=nl+1
- if (itype(il).ne.10) then
- ilnres=il+nres
- else
- ilnres=il
- endif
- if (itype(jl).ne.10) then
- jlnres=jl+nres
- else
- jlnres=jl
- endif
- qqijCM = qcontrib(il,jl,ilnres,jlnres)
- qq = qq+qqijCM
- if (lprn) then
- write (iout,*) "qqijCM",qqijCM
- call flush(iout)
- endif
- enddo
- enddo
- if (lprn) then
- write (iout,*) "nl",nl," qq",qq
- call flush(iout)
- endif
- else
- do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
- nl=nl+1
- if (itype(il).ne.10) then
- ilnres=il+nres
- else
- ilnres=il
- endif
- if (itype(jl).ne.10) then
- jlnres=jl+nres
- else
- jlnres=jl
- endif
- qqijCM = qcontrib(il,jl,ilnres,jlnres)
- qq = qq+qqijCM
- if (lprn) then
- write (iout,*) "qqijCM",qqijCM
- call flush(iout)
- endif
- enddo
- enddo
- endif
- qq = qq/nl
- qwolynes=1.0d0-qq
- do i=0,nres
- do j=1,3
- dqwol(j,i)=dqwol(j,i)/nl
- dxqwol(j,i)=dxqwol(j,i)/nl
- enddo
- enddo
- return
- end
-c-------------------------------------------------------------------
- subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- integer seg1,seg2,seg3,seg4
- logical flag
- double precision qwolan(3,0:maxres),cdummy(3,0:maxres2),
- & qwolxan(3,0:maxres),q1,q2
- double precision delta /1.0d-7/
- write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4
- write(iout,*) "dQ/dc backbone "
- do i=0,nres
- write(iout,'(i5,3e15.5)') i, (dqwol(j,i),j=1,3)
- enddo
- write(iout,*) "dQ/dX side chain "
- do i=1,nres
- write(iout,'(i5,3e15.5)') i,(dxqwol(j,i),j=1,3)
- enddo
- do i=1,nres
- do j=1,3
- cdummy(j,i)=c(j,i)
- c(j,i)=c(j,i)-delta
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- c(j,i)=cdummy(j,i)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolan(j,i)=0.5d0*(q2-q1)/delta
- c(j,i)=cdummy(j,i)
-c write (iout,*) "i",i," j",j," q1",q1," a2",q2
- enddo
- enddo
- do i=1,nres
- do j=1,3
- cdummy(j,i+nres)=c(j,i+nres)
- c(j,i+nres)=c(j,i+nres)-delta
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- c(j,i+nres)=cdummy(j,i+nres)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolxan(j,i)=0.5d0*(q2-q1)/delta
- c(j,i+nres)=cdummy(j,i+nres)
- enddo
- enddo
- write(iout,*) "Numerical Q cartesian gradients backbone: "
- do i=0,nres
- write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
- enddo
- write(iout,*) "Numerical Q cartesian gradients side-chain: "
- do i=0,nres
- write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
- enddo
- return
- end
-c------------------------------------------------------------------------
- subroutine EconstrQ
-c MD with umbrella_sampling using Wolyne's distance measure as a constraint
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision uzap1,uzap2,hm1,hm2,hmnum
- double precision ucdelan,dUcartan(3,0:MAXRES)
- & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES),
- & duconst(3,0:MAXRES),duxconst(3,0:MAXRES)
- integer kstart,kend,lstart,lend,idummy
- double precision delta /1.0d-7/
- do i=0,nres
- do j=1,3
- duconst(j,i)=0.0d0
- dudconst(j,i)=0.0d0
- duxconst(j,i)=0.0d0
- dudxconst(j,i)=0.0d0
- enddo
- enddo
- Uconst=0.0d0
- do i=1,nfrag
- qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.
- & ,idummy,idummy)
- Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
-c Calculating the derivatives of Constraint energy with respect to Q
- Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),qinfrag(i,iset))
-c Calculating the derivatives of Q with respect to cartesian coordinates
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
- enddo
- enddo
-c write (iout,*) "Calling qwol_num"
-c call qwol_num(ifrag(1,i),ifrag(2,i),.true.,idummy,idummy)
- enddo
- do i=1,npair
- kstart=ifrag(1,ipair(1,i,iset),iset)
- kend=ifrag(2,ipair(1,i,iset),iset)
- lstart=ifrag(1,ipair(2,i,iset),iset)
- lend=ifrag(2,ipair(2,i,iset),iset)
- qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
- Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
-c Calculating dU/dQ
- Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
-c Calculating dQ/dXi
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
- enddo
- enddo
- enddo
-c write(iout,*) "Uconst inside subroutine ", Uconst
-c Transforming the gradients from Cs to dCs for the backbone
- do i=0,nres
- do j=i+1,nres
- do k=1,3
- dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
- enddo
- enddo
- enddo
-c Transforming the gradients from Cs to dCs for the side chains
- do i=1,nres
- do j=1,3
- dudxconst(j,i)=duxconst(j,i)
- enddo
- enddo
-c write(iout,*) "dU/dc backbone "
-c do ii=0,nres
-c write(iout,'(i5,3e15.5)') ii, (duconst(j,ii),j=1,3)
-c enddo
-c write(iout,*) "dU/dX side chain "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
-c enddo
-c write(iout,*) "dU/ddc backbone "
-c do ii=0,nres
-c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
-c enddo
-c write(iout,*) "dU/ddX side chain "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(dudxconst(j,ii),j=1,3)
-c enddo
-c Calculating numerical gradients of dUconst/ddc and dUconst/ddx
-c call dEconstrQ_num
- return
- end
-c-----------------------------------------------------------------------
- subroutine dEconstrQ_num
-c Calculating numerical dUconst/ddc and dUconst/ddx
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision uzap1,uzap2
- double precision dUcartan(3,0:MAXRES)
- & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES)
- integer kstart,kend,lstart,lend,idummy
- double precision delta /1.0d-7/
-c For the backbone
- do i=0,nres-1
- do j=1,3
- dUcartan(j,i)=0.0d0
- cdummy(j,i)=dc(j,i)
- dc(j,i)=dc(j,i)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),
- & .true.,idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),
- & qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*
- & harmonic(qpair(ii),qinpair(ii,iset))
- enddo
- dc(j,i)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),
- & .true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*
- & harmonic(qfrag(ii),qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*
- & harmonic(qpair(ii),qinpair(ii,iset))
- enddo
- ducartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
-c Calculating numerical gradients for dU/ddx
- do i=0,nres-1
- do j=1,3
- duxcartan(j,i)=0.0d0
- enddo
- do j=1,3
- cdummy(j,i)=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),
- & .true.,idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*
- & harmonic(qfrag(ii),qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*
- & harmonic(qpair(ii),qinpair(ii,iset))
- enddo
- dc(j,i+nres)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),
- & .true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*
- & harmonic(qfrag(ii),qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*
- & harmonic(qpair(ii),qinpair(ii,iset))
- enddo
- duxcartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
- write(iout,*) "Numerical dUconst/ddc backbone "
- do ii=0,nres
- write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
- enddo
- write(iout,*) "Numerical dUconst/ddx side-chain "
- do ii=1,nres
- write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
- enddo
- return
- end
-c---------------------------------------------------------------------------
- double precision function qcontrib(il,jl,il1,jl1)
- implicit none
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
- integer i,j,k,il,jl,il1,jl1,nd
- double precision dist
- external dist
- double precision dij1,dij2,dij3,dij4,d0ij1,d0ij2,d0ij3,d0ij4,fac,
- & fac1,ddave,ssij,ddqij
- logical lprn /.false./
- d0ij1=dsqrt((cref(1,jl)-cref(1,il))**2+
- & (cref(2,jl)-cref(2,il))**2+
- & (cref(3,jl)-cref(3,il))**2)
- dij1=dist(il,jl)
- ddave=(dij1-d0ij1)**2
- nd=1
- if (jl1.ne.jl) then
- d0ij2=dsqrt((cref(1,jl1)-cref(1,il))**2+
- & (cref(2,jl1)-cref(2,il))**2+
- & (cref(3,jl1)-cref(3,il))**2)
- dij2=dist(il,jl1)
- ddave=ddave+(dij2-d0ij2)**2
- nd=nd+1
- endif
- if (il1.ne.il) then
- d0ij3=dsqrt((cref(1,jl)-cref(1,il1))**2+
- & (cref(2,jl)-cref(2,il1))**2+
- & (cref(3,jl)-cref(3,il1))**2)
- dij3=dist(il1,jl)
- ddave=ddave+(dij3-d0ij3)**2
- nd=nd+1
- endif
- if (il1.ne.il .and. jl1.ne.jl) then
- d0ij4=dsqrt((cref(1,jl1)-cref(1,il1))**2+
- & (cref(2,jl1)-cref(2,il1))**2+
- & (cref(3,jl1)-cref(3,il1))**2)
- dij4=dist(il1,jl1)
- ddave=ddave+(dij4-d0ij4)**2
- nd=nd+1
- endif
- ddave=ddave/nd
- if (lprn) then
- write (iout,*) "il",il," jl",jl,
- & " itype",itype(il),itype(jl)," nd",nd
- write (iout,*)"d0ij",d0ij1,d0ij2,d0ij3,d0ij4,
- & " dij",dij1,dij2,dij3,dij4," ddave",ddave
- call flush(iout)
- endif
-c ssij = (0.25d0*d0ij1)**2
- if (il.ne.il1 .and. jl.ne.jl1) then
- ssij = 16.0d0/(d0ij1*d0ij4)
- else
- ssij = 16.0d0/(d0ij1*d0ij1)
- endif
- qcontrib = dexp(-0.5d0*ddave*ssij)
-c Compute gradient
- fac1 = qcontrib*ssij/nd
- fac = fac1*(dij1-d0ij1)/dij1
- do k=1,3
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
- enddo
- if (jl1.ne.jl) then
- fac = fac1*(dij2-d0ij2)/dij2
- do k=1,3
- ddqij = (c(k,il)-c(k,jl1))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
- if (il1.ne.il) then
- fac = fac1*(dij3-d0ij3)/dij3
- do k=1,3
- ddqij = (c(k,il1)-c(k,jl))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
- enddo
- endif
- if (il1.ne.il .and. jl1.ne.jl) then
- fac = fac1*(dij4-d0ij4)/dij4
- do k=1,3
- ddqij = (c(k,il1)-c(k,jl1))*fac
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- enddo
- endif
- return
- end
+++ /dev/null
- double precision function qwolynes(seg1,seg2,flag,seg3,seg4)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- integer i,j,jl,k,l,il,kl,nl,np,seg1,seg2,seg3,seg4,secseg
- integer nsep /3/
- double precision dist,qm
- double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM
- logical lprn /.false./
- logical flag
- qq = 0.0d0
- nl=0
- do i=0,nres
- do j=1,3
- dqwol(j,i)=0.0d0
- dxqwol(j,i)=0.0d0
- enddo
- enddo
- if (lprn) then
- write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4,
- & " flag",flag
- call flush(iout)
- endif
- if (flag) then
- do il=seg1+nsep,seg2
- do jl=seg1,il-nsep
- nl=nl+1
- if (itype(il).ne.10) then
- ilnres=il+nres
- else
- ilnres=il
- endif
- if (itype(jl).ne.10) then
- jlnres=jl+nres
- else
- jlnres=jl
- endif
- qqijCM = qcontrib(il,jl,ilnres,jlnres)
- qq = qq+qqijCM
- if (lprn) then
- write (iout,*) "qqijCM",qqijCM
- call flush(iout)
- endif
- enddo
- enddo
- if (lprn) then
- write (iout,*) "nl",nl," qq",qq
- call flush(iout)
- endif
- else
- do il=seg1,seg2
- if((seg3-il).lt.3) then
- secseg=il+3
- else
- secseg=seg3
- endif
- do jl=secseg,seg4
- nl=nl+1
- if (itype(il).ne.10) then
- ilnres=il+nres
- else
- ilnres=il
- endif
- if (itype(jl).ne.10) then
- jlnres=jl+nres
- else
- jlnres=jl
- endif
- qqijCM = qcontrib(il,jl,ilnres,jlnres)
- qq = qq+qqijCM
- if (lprn) then
- write (iout,*) "qqijCM",qqijCM
- call flush(iout)
- endif
- enddo
- enddo
- endif
- qq = qq/nl
- qwolynes=1.0d0-qq
- do i=0,nres
- do j=1,3
- dqwol(j,i)=dqwol(j,i)/nl
- dxqwol(j,i)=dxqwol(j,i)/nl
- enddo
- enddo
- return
- end
-c-------------------------------------------------------------------
- subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.MD'
- integer seg1,seg2,seg3,seg4
- logical flag
- double precision qwolan(3,0:maxres),cdummy(3,0:maxres2),
- & qwolxan(3,0:maxres),q1,q2
- double precision delta /1.0d-7/
- write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4
- write(iout,*) "dQ/dc backbone "
- do i=0,nres
- write(iout,'(i5,3e15.5)') i, (dqwol(j,i),j=1,3)
- enddo
- write(iout,*) "dQ/dX side chain "
- do i=1,nres
- write(iout,'(i5,3e15.5)') i,(dxqwol(j,i),j=1,3)
- enddo
- do i=1,nres
- do j=1,3
- cdummy(j,i)=c(j,i)
- c(j,i)=c(j,i)-delta
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- c(j,i)=cdummy(j,i)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolan(j,i)=0.5d0*(q2-q1)/delta
- c(j,i)=cdummy(j,i)
-c write (iout,*) "i",i," j",j," q1",q1," a2",q2
- enddo
- enddo
- do i=1,nres
- do j=1,3
- cdummy(j,i+nres)=c(j,i+nres)
- c(j,i+nres)=c(j,i+nres)-delta
- q1=qwolynes(seg1,seg2,flag,seg3,seg4)
- c(j,i+nres)=cdummy(j,i+nres)+delta
- q2=qwolynes(seg1,seg2,flag,seg3,seg4)
- qwolxan(j,i)=0.5d0*(q2-q1)/delta
- c(j,i+nres)=cdummy(j,i+nres)
- enddo
- enddo
- write(iout,*) "Numerical Q cartesian gradients backbone: "
- do i=0,nres
- write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
- enddo
- write(iout,*) "Numerical Q cartesian gradients side-chain: "
- do i=0,nres
- write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
- enddo
- return
- end
-c------------------------------------------------------------------------
- subroutine EconstrQ
-c MD with umbrella_sampling using Wolyne's distance measure as a constraint
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision uzap1,uzap2,hm1,hm2,hmnum
- double precision ucdelan,dUcartan(3,0:MAXRES)
- & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES),
- & duconst(3,0:MAXRES),duxconst(3,0:MAXRES)
- integer kstart,kend,lstart,lend,idummy
- double precision delta /1.0d-7/
- do i=0,nres
- do j=1,3
- duconst(j,i)=0.0d0
- dudconst(j,i)=0.0d0
- duxconst(j,i)=0.0d0
- dudxconst(j,i)=0.0d0
- enddo
- enddo
- Uconst=0.0d0
- do i=1,nfrag
- qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.
- & ,idummy,idummy)
- Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
-c Calculating the derivatives of Constraint energy with respect to Q
- Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),qinfrag(i,iset))
-c Calculating the derivatives of Q with respect to cartesian coordinates
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
- enddo
- enddo
-c write (iout,*) "Calling qwol_num"
-c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.,idummy,idummy)
- enddo
-c stop
- do i=1,npair
- kstart=ifrag(1,ipair(1,i,iset),iset)
- kend=ifrag(2,ipair(1,i,iset),iset)
- lstart=ifrag(1,ipair(2,i,iset),iset)
- lend=ifrag(2,ipair(2,i,iset),iset)
- qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
- Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
-c Calculating dU/dQ
- Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
-c Calculating dQ/dXi
- do ii=0,nres
- do j=1,3
- duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
- dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
- enddo
- enddo
- enddo
-c write(iout,*) "Uconst inside subroutine ", Uconst
-c Transforming the gradients from Cs to dCs for the backbone
- do i=0,nres
- do j=i+1,nres
- do k=1,3
- dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
- enddo
- enddo
- enddo
-c Transforming the gradients from Cs to dCs for the side chains
- do i=1,nres
- do j=1,3
- dudxconst(j,i)=duxconst(j,i)
- enddo
- enddo
-c write(iout,*) "dU/dc backbone "
-c do ii=0,nres
-c write(iout,'(i5,3e15.5)') ii, (duconst(j,ii),j=1,3)
-c enddo
-c write(iout,*) "dU/dX side chain "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
-c enddo
-c write(iout,*) "dU/ddc backbone "
-c do ii=0,nres
-c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
-c enddo
-c write(iout,*) "dU/ddX side chain "
-c do ii=1,nres
-c write(iout,'(i5,3e15.5)') ii,(dudxconst(j,ii),j=1,3)
-c enddo
-c Calculating numerical gradients of dUconst/ddc and dUconst/ddx
-c call dEconstrQ_num
- return
- end
-c-----------------------------------------------------------------------
- subroutine dEconstrQ_num
-c Calculating numerical dUconst/ddc and dUconst/ddx
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision uzap1,uzap2
- double precision dUcartan(3,0:MAXRES)
- & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES)
- integer kstart,kend,lstart,lend,idummy
- double precision delta /1.0d-7/
-c For the backbone
- do i=0,nres-1
- do j=1,3
- dUcartan(j,i)=0.0d0
- cdummy(j,i)=dc(j,i)
- dc(j,i)=dc(j,i)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),
- & .true.,idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*
- & harmonic(qfrag(ii),qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*
- & harmonic(qpair(ii),qinpair(ii,iset))
- enddo
- dc(j,i)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),
- & .true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*
- & harmonic(qfrag(ii),qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*
- & harmonic(qpair(ii),qinpair(ii,iset))
- enddo
- ducartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
-c Calculating numerical gradients for dU/ddx
- do i=0,nres-1
- do j=1,3
- duxcartan(j,i)=0.0d0
- enddo
- do j=1,3
- cdummy(j,i)=dc(j,i+nres)
- dc(j,i+nres)=dc(j,i+nres)+delta
- call chainbuild_cart
- uzap2=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),
- & .true.,idummy,idummy)
- uzap2=uzap2+wfrag(ii,iset)*
- & harmonic(qfrag(ii),qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap2=uzap2+wpair(ii,iset)*
- & harmonic(qpair(ii),qinpair(ii,iset))
- enddo
- dc(j,i+nres)=cdummy(j,i)
- call chainbuild_cart
- uzap1=0.0d0
- do ii=1,nfrag
- qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),
- & .true.,idummy,idummy)
- uzap1=uzap1+wfrag(ii,iset)*
- & harmonic(qfrag(ii),qinfrag(ii,iset))
- enddo
- do ii=1,npair
- kstart=ifrag(1,ipair(1,ii,iset),iset)
- kend=ifrag(2,ipair(1,ii,iset),iset)
- lstart=ifrag(1,ipair(2,ii,iset),iset)
- lend=ifrag(2,ipair(2,ii,iset),iset)
- qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
- uzap1=uzap1+wpair(ii,iset)*
- & harmonic(qpair(ii),qinpair(ii,iset))
- enddo
- duxcartan(j,i)=(uzap2-uzap1)/(delta)
- enddo
- enddo
- write(iout,*) "Numerical dUconst/ddc backbone "
- do ii=0,nres
- write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
- enddo
- write(iout,*) "Numerical dUconst/ddx side-chain "
- do ii=1,nres
- write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
- enddo
- return
- end
-c---------------------------------------------------------------------------
- double precision function qcontrib(il,jl,il1,jl1)
- implicit none
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
- include 'COMMON.LOCAL'
- integer i,j,k,il,jl,il1,jl1,nd,itl,jtl
- double precision dist
- external dist
- double precision dij,dij1,d0ij,d0ij1,om1,om2,om12,om10,om20,om120
- & ,fac,fac1,ddave,ssij,ddqij,d0ii1,d0jj1,rij,eom1,eom2,eom12
- double precision u(3),v(3),er(3),er0(3),dcosom1(3),dcosom2(3),
- & aux1,aux2
- double precision scalar
- external scalar
- logical lprn /.false./
- if (lprn) write (iout,*) "il",il," jl",jl," il1",il1," jl1",jl1
- d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+
- & (cref(2,jl)-cref(2,il))**2+
- & (cref(3,jl)-cref(3,il))**2)
- dij=dist(il,jl)
- dij1=dist(il1,jl1)
- do i=1,3
- er(i)=(c(i,jl1)-c(i,il1))/dij1
- enddo
- do i=1,3
- er0(i)=cref(i,jl1)-cref(i,il1)
- enddo
- d0ij1=dsqrt(scalar(er0,er0))
- do i=1,3
- er0(i)=er0(i)/d0ij1
- enddo
- if (il.ne.il1 .or. jl.ne.jl1) then
- ddave=0.5d0*((dij-d0ij)**2+(dij1-d0ij1)**2)
- nd=2
- else
- ddave=(dij-d0ij)**2
- nd=1
- endif
- if (il.ne.il1) then
- do i=1,3
- u(i)=cref(i,il1)-cref(i,il)
- enddo
- d0ii1=dsqrt(scalar(u,u))
- do i=1,3
- u(i)=u(i)/d0ii1
- enddo
- if (lprn) then
- write (iout,*) "u",(u(i),i=1,3)
- write (iout,*) "er0",(er0(i),i=1,3)
- om10=scalar(er0,u)
- om1=scalar(er,dc_norm(1,il1))
- write (iout,*) "om10",om10," om1",om1
- endif
- else
- om1=0.0d0
- om10=0.0d0
- endif
- if (jl.ne.jl1) then
- do i=1,3
- v(i)=cref(i,jl1)-cref(i,jl)
- enddo
- d0jj1=dsqrt(scalar(v,v))
- do i=1,3
- v(i)=v(i)/d0jj1
- enddo
- if (lprn) then
- write (iout,*) "v",(v(i),i=1,3)
- write (iout,*) "er0",(er0(i),i=1,3)
- om20=scalar(er,v)
- om2=scalar(er,dc_norm(1,jl1))
- write (iout,*) "om20",om20," om2",om2
- endif
- else
- om2=0.0d0
- om20=0.0d0
- endif
- if (il.ne.il1 .and. jl.ne.jl1) then
- om120=scalar(u,v)
- om12=scalar(dc_norm(1,il1),dc_norm(1,jl1))
- else
- om12=0.0d0
- om120=0.0d0
- endif
- if (lprn) then
- write (iout,*) "il",il," jl",jl,itype(il),itype(jl)
- write (iout,*)"d0ij",d0ij," om10",om10," om20",om20,
- & " om120",om120,
- & " dij",dij," om1",om1," om2",om2," om12",om12
- call flush(iout)
- endif
- ssij = 16.0d0/(d0ij*d0ij)
- qcontrib = dexp(-0.5d0*(ddave*ssij+((om1-om10)**2
- & +(om2-om20)**2+(om12-om120)**2)))
- if (lprn) write (iout,*) "ssij",ssij," qcontrib",qcontrib
-c qcontrib = dexp(-0.5d0*(ddave*ssij)+(om1-om10)**2+(om2-om20)**2)
-c qcontrib = dexp(-0.5d0*(ddave*ssij))
-c Compute gradient - radial component
- fac1 = qcontrib*ssij/nd
- fac = fac1*(dij-d0ij)/dij
- do k=1,3
- ddqij = (c(k,il)-c(k,jl))*fac
- dqwol(k,il)=dqwol(k,il)+ddqij
- dqwol(k,jl)=dqwol(k,jl)-ddqij
- enddo
- if (il1.ne.il .or. jl1.ne.jl) then
- fac = fac1*(dij1-d0ij1)/dij1
- do k=1,3
- ddqij = (c(k,il1)-c(k,jl1))*fac
- if (il1.ne.il) then
- dxqwol(k,il)=dxqwol(k,il)+ddqij
- else
- dqwol(k,il)=dqwol(k,il)+ddqij
- endif
- if (jl1.ne.jl) then
- dxqwol(k,jl)=dxqwol(k,jl)-ddqij
- else
- dqwol(k,jl)=dqwol(k,jl)-ddqij
- endif
- enddo
- endif
-c return
-c Orientational contributions
- rij=1.0d0/dij1
- eom1=qcontrib*(om1-om10)
- eom2=qcontrib*(om2-om20)
- eom12=qcontrib*(om12-om120)
- do k=1,3
- dcosom1(k)=rij*(dc_norm(k,il1)-om1*er(k))
- dcosom2(k)=rij*(dc_norm(k,jl1)-om2*er(k))
- enddo
- do k=1,3
- ddqij=eom1*dcosom1(k)+eom2*dcosom2(k)
- aux1=(eom12*(dc_norm(k,jl1)-om12*dc_norm(k,il1))
- & +eom1*(er(k)-om1*dc_norm(k,il1)))*vbld_inv(il1)
- aux2=(eom12*(dc_norm(k,il1)-om12*dc_norm(k,jl1))
- & +eom2*(er(k)-om2*dc_norm(k,jl1)))*vbld_inv(jl1)
- dqwol(k,il)=dqwol(k,il)-ddqij-aux1
- dqwol(k,jl)=dqwol(k,jl)+ddqij-aux2
- dxqwol(k,il)=dxqwol(k,il)-ddqij+aux1
-c & +(eom12*(dc_norm(k,jl1)-om12*dc_norm(k,il1))
-c & +eom1*(er(k)-om1*dc_norm(k,il1)))*vbld_inv(il1)
- dxqwol(k,jl)=dxqwol(k,jl)+ddqij+aux2
-c & +(eom12*(dc_norm(k,il1)-om12*dc_norm(k,jl1))
-c & +eom2*(er(k)-om2*dc_norm(k,jl1)))*vbld_inv(jl1)
- enddo
- return
- end
+++ /dev/null
-C $Date: 1994/10/04 16:19:52 $
-C $Revision: 2.1 $
-C
-C
-C See help for RANDOMV on the PSFSHARE disk to understand these
-C subroutines. This is the VS Fortran version of this code.
-C
-C
- SUBROUTINE VRND(VEC,N)
- INTEGER A(250)
- COMMON /VRANDD/ A, I, I147
- INTEGER LOOP,I,I147,VEC(N)
- DO 23000 LOOP=1,N
- I=I+1
- IF(.NOT.(I.GE.251))GOTO 23002
- I=1
-23002 CONTINUE
- I147=I147+1
- IF(.NOT.(I147.GE.251))GOTO 23004
- I147=1
-23004 CONTINUE
- A(I)=IEOR(A(I147),A(I))
- VEC(LOOP)=A(I)
-23000 CONTINUE
- RETURN
- END
-C
-C
- DOUBLE PRECISION FUNCTION RNDV(IDUM)
- DOUBLE PRECISION RM1,RM2,R(99)
- INTEGER IA1,IC1,M1, IA2,IC2,M2, IA3,IC3,M3, IDUM
- SAVE
- DATA IA1,IC1,M1/1279,351762,1664557/
- DATA IA2,IC2,M2/2011,221592,1048583/
- DATA IA3,IC3,M3/15551,6150,29101/
- IF(.NOT.(IDUM.LT.0))GOTO 23006
- IX1 = MOD(-IDUM,M1)
- IX1 = MOD(IA1*IX1+IC1,M1)
- IX2 = MOD(IX1,M2)
- IX1 = MOD(IA1*IX1+IC1,M1)
- IX3 = MOD(IX1,M3)
- RM1 = 1./DBLE(M1)
- RM2 = 1./DBLE(M2)
- DO 23008 J = 1,99
- IX1 = MOD(IA1*IX1+IC1,M1)
- IX2 = MOD(IA2*IX2+IC2,M2)
- R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1
-23008 CONTINUE
-23006 CONTINUE
- IX1 = MOD(IA1*IX1+IC1,M1)
- IX2 = MOD(IA2*IX2+IC2,M2)
- IX3 = MOD(IA3*IX3+IC3,M3)
- J = 1+(99*IX3)/M3
- RNDV = R(J)
- R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1
- IDUM = IX1
- RETURN
- END
-C
-C
- SUBROUTINE VRNDST(SEED)
- INTEGER A(250),LOOP,IDUM,SEED
- DOUBLE PRECISION RNDV
- COMMON /VRANDD/ A, I, I147
- I=0
- I147=103
- IDUM=SEED
- DO 23010 LOOP=1,250
- A(LOOP)=INT(RNDV(IDUM)*2147483647)
-23010 CONTINUE
- RETURN
- END
-C
-C
- SUBROUTINE VRNDIN(IODEV)
- INTEGER IODEV, A(250)
- COMMON/VRANDD/ A, I, I147
- READ(IODEV) A, I, I147
- RETURN
- END
-C
-C
- SUBROUTINE VRNDOU(IODEV)
-C This corresponds to VRNDOUT in the APFTN64 version
- INTEGER IODEV, A(250)
- COMMON/VRANDD/ A, I, I147
- WRITE(IODEV) A, I, I147
- RETURN
- END
- FUNCTION RNUNF(N)
- INTEGER IRAN1(2000)
- DATA FCTOR /2147483647.0D0/
-C We get only one random number, here! DR 9/1/92
- CALL VRND(IRAN1,1)
- RNUNF= DBLE( IRAN1(1) ) / FCTOR
-C******************************
-C write(6,*) 'rnunf in rnunf = ',rnunf
- RETURN
- END
+++ /dev/null
- subroutine rattle1
-c RATTLE algorithm for velocity Verlet - step 1, UNRES
-c AL 9/24/04
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision gginv(maxres2,maxres2),
- & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2),
- & Cmat(MAXRES2,MAXRES2),x(MAXRES2),xcorr(3,MAXRES2)
- common /przechowalnia/ GGinv,gdc,Cmat,nbond
- integer max_rattle /5/
- logical lprn /.false./, lprn1 /.false./,not_done
- double precision tol_rattle /1.0d-5/
- if (lprn) write (iout,*) "RATTLE1"
- nbond=nct-nnt
- do i=nnt,nct
- if (itype(i).ne.10) nbond=nbond+1
- enddo
-c Make a folded form of the Ginv-matrix
- ind=0
- ii=0
- do i=nnt,nct-1
- ii=ii+1
- do j=1,3
- ind=ind+1
- ind1=0
- jj=0
- do k=nnt,nct-1
- jj=jj+1
- do l=1,3
- ind1=ind1+1
- if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1)
- enddo
- enddo
- do k=nnt,nct
- if (itype(k).ne.10) then
- jj=jj+1
- do l=1,3
- ind1=ind1+1
- if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1)
- enddo
- endif
- enddo
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ii=ii+1
- do j=1,3
- ind=ind+1
- ind1=0
- jj=0
- do k=nnt,nct-1
- jj=jj+1
- do l=1,3
- ind1=ind1+1
- if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1)
- enddo
- enddo
- do k=nnt,nct
- if (itype(k).ne.10) then
- jj=jj+1
- do l=1,3
- ind1=ind1+1
- if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1)
- enddo
- endif
- enddo
- enddo
- endif
- enddo
- if (lprn1) then
- write (iout,*) "Matrix GGinv"
- call MATOUT(nbond,nbond,MAXRES2,MAXRES2,GGinv)
- endif
- not_done=.true.
- iter=0
- do while (not_done)
- iter=iter+1
- if (iter.gt.max_rattle) then
- write (iout,*) "Error - too many iterations in RATTLE."
- stop
- endif
-c Calculate the matrix C = GG**(-1) dC_old o dC
- ind1=0
- do i=nnt,nct-1
- ind1=ind1+1
- do j=1,3
- dC_uncor(j,ind1)=dC(j,i)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind1=ind1+1
- do j=1,3
- dC_uncor(j,ind1)=dC(j,i+nres)
- enddo
- endif
- enddo
- do i=1,nbond
- ind=0
- do k=nnt,nct-1
- ind=ind+1
- do j=1,3
- gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k)
- enddo
- enddo
- do k=nnt,nct
- if (itype(k).ne.10) then
- ind=ind+1
- do j=1,3
- gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k+nres)
- enddo
- endif
- enddo
- enddo
-c Calculate deviations from standard virtual-bond lengths
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- x(ind)=vbld(i+1)**2-vbl**2
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- x(ind)=vbld(i+nres)**2-vbldsc0(1,itype(i))**2
- endif
- enddo
- if (lprn) then
- write (iout,*) "Coordinates and violations"
- do i=1,nbond
- write(iout,'(i5,3f10.5,5x,e15.5)')
- & i,(dC_uncor(j,i),j=1,3),x(i)
- enddo
- write (iout,*) "Velocities and violations"
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i))
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i+nres,ind,(d_t_new(j,i+nres),j=1,3),
- & scalar(d_t_new(1,i+nres),dC_old(1,i+nres))
- endif
- enddo
-c write (iout,*) "gdc"
-c do i=1,nbond
-c write (iout,*) "i",i
-c do j=1,nbond
-c write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3)
-c enddo
-c enddo
- endif
- xmax=dabs(x(1))
- do i=2,nbond
- if (dabs(x(i)).gt.xmax) then
- xmax=dabs(x(i))
- endif
- enddo
- if (xmax.lt.tol_rattle) then
- not_done=.false.
- goto 100
- endif
-c Calculate the matrix of the system of equations
- do i=1,nbond
- do j=1,nbond
- Cmat(i,j)=0.0d0
- do k=1,3
- Cmat(i,j)=Cmat(i,j)+dC_uncor(k,i)*gdc(k,i,j)
- enddo
- enddo
- enddo
- if (lprn1) then
- write (iout,*) "Matrix Cmat"
- call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat)
- endif
- call gauss(Cmat,X,MAXRES2,nbond,1,*10)
-c Add constraint term to positions
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- do j=1,3
- xx=0.0d0
- do ii=1,nbond
- xx = xx+x(ii)*gdc(j,ind,ii)
- enddo
- xx=0.5d0*xx
- dC(j,i)=dC(j,i)-xx
- d_t_new(j,i)=d_t_new(j,i)-xx/d_time
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- do j=1,3
- xx=0.0d0
- do ii=1,nbond
- xx = xx+x(ii)*gdc(j,ind,ii)
- enddo
- xx=0.5d0*xx
- dC(j,i+nres)=dC(j,i+nres)-xx
- d_t_new(j,i+nres)=d_t_new(j,i+nres)-xx/d_time
- enddo
- endif
- enddo
-c Rebuild the chain using the new coordinates
- call chainbuild_cart
- if (lprn) then
- write (iout,*) "New coordinates, Lagrange multipliers,",
- & " and differences between actual and standard bond lengths"
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- xx=vbld(i+1)**2-vbl**2
- write (iout,'(i5,3f10.5,5x,f10.5,e15.5)')
- & i,(dC(j,i),j=1,3),x(ind),xx
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- xx=vbld(i+nres)**2-vbldsc0(1,itype(i))**2
- write (iout,'(i5,3f10.5,5x,f10.5,e15.5)')
- & i,(dC(j,i+nres),j=1,3),x(ind),xx
- endif
- enddo
- write (iout,*) "Velocities and violations"
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i))
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i+nres,ind,(d_t_new(j,i+nres),j=1,3),
- & scalar(d_t_new(1,i+nres),dC_old(1,i+nres))
- endif
- enddo
- endif
- enddo
- 100 continue
- return
- 10 write (iout,*) "Error - singularity in solving the system",
- & " of equations for Lagrange multipliers."
- stop
- end
-c------------------------------------------------------------------------------
- subroutine rattle2
-c RATTLE algorithm for velocity Verlet - step 2, UNRES
-c AL 9/24/04
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision gginv(maxres2,maxres2),
- & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2),
- & Cmat(MAXRES2,MAXRES2),x(MAXRES2)
- common /przechowalnia/ GGinv,gdc,Cmat,nbond
- integer max_rattle /5/
- logical lprn /.false./, lprn1 /.false./,not_done
- double precision tol_rattle /1.0d-5/
- if (lprn) write (iout,*) "RATTLE2"
- if (lprn) write (iout,*) "Velocity correction"
-c Calculate the matrix G dC
- do i=1,nbond
- ind=0
- do k=nnt,nct-1
- ind=ind+1
- do j=1,3
- gdc(j,i,ind)=GGinv(i,ind)*dC(j,k)
- enddo
- enddo
- do k=nnt,nct
- if (itype(k).ne.10) then
- ind=ind+1
- do j=1,3
- gdc(j,i,ind)=GGinv(i,ind)*dC(j,k+nres)
- enddo
- endif
- enddo
- enddo
-c if (lprn) then
-c write (iout,*) "gdc"
-c do i=1,nbond
-c write (iout,*) "i",i
-c do j=1,nbond
-c write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3)
-c enddo
-c enddo
-c endif
-c Calculate the matrix of the system of equations
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- do j=1,nbond
- Cmat(ind,j)=0.0d0
- do k=1,3
- Cmat(ind,j)=Cmat(ind,j)+dC(k,i)*gdc(k,ind,j)
- enddo
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- do j=1,nbond
- Cmat(ind,j)=0.0d0
- do k=1,3
- Cmat(ind,j)=Cmat(ind,j)+dC(k,i+nres)*gdc(k,ind,j)
- enddo
- enddo
- endif
- enddo
-c Calculate the scalar product dC o d_t_new
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- x(ind)=scalar(d_t(1,i),dC(1,i))
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- x(ind)=scalar(d_t(1,i+nres),dC(1,i+nres))
- endif
- enddo
- if (lprn) then
- write (iout,*) "Velocities and violations"
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i,ind,(d_t(j,i),j=1,3),x(ind)
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i+nres,ind,(d_t(j,i+nres),j=1,3),x(ind)
- endif
- enddo
- endif
- xmax=dabs(x(1))
- do i=2,nbond
- if (dabs(x(i)).gt.xmax) then
- xmax=dabs(x(i))
- endif
- enddo
- if (xmax.lt.tol_rattle) then
- not_done=.false.
- goto 100
- endif
- if (lprn1) then
- write (iout,*) "Matrix Cmat"
- call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat)
- endif
- call gauss(Cmat,X,MAXRES2,nbond,1,*10)
-c Add constraint term to velocities
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- do j=1,3
- xx=0.0d0
- do ii=1,nbond
- xx = xx+x(ii)*gdc(j,ind,ii)
- enddo
- d_t(j,i)=d_t(j,i)-xx
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- do j=1,3
- xx=0.0d0
- do ii=1,nbond
- xx = xx+x(ii)*gdc(j,ind,ii)
- enddo
- d_t(j,i+nres)=d_t(j,i+nres)-xx
- enddo
- endif
- enddo
- if (lprn) then
- write (iout,*)
- & "New velocities, Lagrange multipliers violations"
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- if (lprn) write (iout,'(2i5,3f10.5,5x,2e15.5)')
- & i,ind,(d_t(j,i),j=1,3),x(ind),scalar(d_t(1,i),dC(1,i))
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,2e15.5)')
- & i+nres,ind,(d_t(j,i+nres),j=1,3),x(ind),
- & scalar(d_t(1,i+nres),dC(1,i+nres))
- endif
- enddo
- endif
- 100 continue
- return
- 10 write (iout,*) "Error - singularity in solving the system",
- & " of equations for Lagrange multipliers."
- stop
- end
-c------------------------------------------------------------------------------
- subroutine rattle_brown
-c RATTLE/LINCS algorithm for Brownian dynamics, UNRES
-c AL 9/24/04
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- include 'COMMON.TIME1'
- double precision gginv(maxres2,maxres2),
- & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2),
- & Cmat(MAXRES2,MAXRES2),x(MAXRES2)
- common /przechowalnia/ GGinv,gdc,Cmat,nbond
- integer max_rattle /5/
- logical lprn /.true./, lprn1 /.true./,not_done
- double precision tol_rattle /1.0d-5/
- if (lprn) write (iout,*) "RATTLE_BROWN"
- nbond=nct-nnt
- do i=nnt,nct
- if (itype(i).ne.10) nbond=nbond+1
- enddo
-c Make a folded form of the Ginv-matrix
- ind=0
- ii=0
- do i=nnt,nct-1
- ii=ii+1
- do j=1,3
- ind=ind+1
- ind1=0
- jj=0
- do k=nnt,nct-1
- jj=jj+1
- do l=1,3
- ind1=ind1+1
- if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1)
- enddo
- enddo
- do k=nnt,nct
- if (itype(k).ne.10) then
- jj=jj+1
- do l=1,3
- ind1=ind1+1
- if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1)
- enddo
- endif
- enddo
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ii=ii+1
- do j=1,3
- ind=ind+1
- ind1=0
- jj=0
- do k=nnt,nct-1
- jj=jj+1
- do l=1,3
- ind1=ind1+1
- if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1)
- enddo
- enddo
- do k=nnt,nct
- if (itype(k).ne.10) then
- jj=jj+1
- do l=1,3
- ind1=ind1+1
- if (j.eq.1 .and. l.eq.1)GGinv(ii,jj)=fricmat(ind,ind1)
- enddo
- endif
- enddo
- enddo
- endif
- enddo
- if (lprn1) then
- write (iout,*) "Matrix GGinv"
- call MATOUT(nbond,nbond,MAXRES2,MAXRES2,GGinv)
- endif
- not_done=.true.
- iter=0
- do while (not_done)
- iter=iter+1
- if (iter.gt.max_rattle) then
- write (iout,*) "Error - too many iterations in RATTLE."
- stop
- endif
-c Calculate the matrix C = GG**(-1) dC_old o dC
- ind1=0
- do i=nnt,nct-1
- ind1=ind1+1
- do j=1,3
- dC_uncor(j,ind1)=dC(j,i)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind1=ind1+1
- do j=1,3
- dC_uncor(j,ind1)=dC(j,i+nres)
- enddo
- endif
- enddo
- do i=1,nbond
- ind=0
- do k=nnt,nct-1
- ind=ind+1
- do j=1,3
- gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k)
- enddo
- enddo
- do k=nnt,nct
- if (itype(k).ne.10) then
- ind=ind+1
- do j=1,3
- gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k+nres)
- enddo
- endif
- enddo
- enddo
-c Calculate deviations from standard virtual-bond lengths
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- x(ind)=vbld(i+1)**2-vbl**2
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- x(ind)=vbld(i+nres)**2-vbldsc0(1,itype(i))**2
- endif
- enddo
- if (lprn) then
- write (iout,*) "Coordinates and violations"
- do i=1,nbond
- write(iout,'(i5,3f10.5,5x,e15.5)')
- & i,(dC_uncor(j,i),j=1,3),x(i)
- enddo
- write (iout,*) "Velocities and violations"
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i,ind,(d_t(j,i),j=1,3),scalar(d_t(1,i),dC_old(1,i))
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i+nres,ind,(d_t(j,i+nres),j=1,3),
- & scalar(d_t(1,i+nres),dC_old(1,i+nres))
- endif
- enddo
- write (iout,*) "gdc"
- do i=1,nbond
- write (iout,*) "i",i
- do j=1,nbond
- write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3)
- enddo
- enddo
- endif
- xmax=dabs(x(1))
- do i=2,nbond
- if (dabs(x(i)).gt.xmax) then
- xmax=dabs(x(i))
- endif
- enddo
- if (xmax.lt.tol_rattle) then
- not_done=.false.
- goto 100
- endif
-c Calculate the matrix of the system of equations
- do i=1,nbond
- do j=1,nbond
- Cmat(i,j)=0.0d0
- do k=1,3
- Cmat(i,j)=Cmat(i,j)+dC_uncor(k,i)*gdc(k,i,j)
- enddo
- enddo
- enddo
- if (lprn1) then
- write (iout,*) "Matrix Cmat"
- call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat)
- endif
- call gauss(Cmat,X,MAXRES2,nbond,1,*10)
-c Add constraint term to positions
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- do j=1,3
- xx=0.0d0
- do ii=1,nbond
- xx = xx+x(ii)*gdc(j,ind,ii)
- enddo
- xx=-0.5d0*xx
- d_t(j,i)=d_t(j,i)+xx/d_time
- dC(j,i)=dC(j,i)+xx
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- do j=1,3
- xx=0.0d0
- do ii=1,nbond
- xx = xx+x(ii)*gdc(j,ind,ii)
- enddo
- xx=-0.5d0*xx
- d_t(j,i+nres)=d_t(j,i+nres)+xx/d_time
- dC(j,i+nres)=dC(j,i+nres)+xx
- enddo
- endif
- enddo
-c Rebuild the chain using the new coordinates
- call chainbuild_cart
- if (lprn) then
- write (iout,*) "New coordinates, Lagrange multipliers,",
- & " and differences between actual and standard bond lengths"
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- xx=vbld(i+1)**2-vbl**2
- write (iout,'(i5,3f10.5,5x,f10.5,e15.5)')
- & i,(dC(j,i),j=1,3),x(ind),xx
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- xx=vbld(i+nres)**2-vbldsc0(1,itype(i))**2
- write (iout,'(i5,3f10.5,5x,f10.5,e15.5)')
- & i,(dC(j,i+nres),j=1,3),x(ind),xx
- endif
- enddo
- write (iout,*) "Velocities and violations"
- ind=0
- do i=nnt,nct-1
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i))
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- ind=ind+1
- write (iout,'(2i5,3f10.5,5x,e15.5)')
- & i+nres,ind,(d_t_new(j,i+nres),j=1,3),
- & scalar(d_t_new(1,i+nres),dC_old(1,i+nres))
- endif
- enddo
- endif
- enddo
- 100 continue
- return
- 10 write (iout,*) "Error - singularity in solving the system",
- & " of equations for Lagrange multipliers."
- stop
- end
+++ /dev/null
- subroutine readpdb
-C Read the PDB file and convert the peptide geometry into virtual-chain
-C geometry.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.NAMES'
- include 'COMMON.CONTROL'
- include 'COMMON.DISTFIT'
- include 'COMMON.SETUP'
- character*3 seq,atom,res
- character*80 card
- dimension sccor(3,20)
- double precision e1(3),e2(3),e3(3)
- logical fail
- integer rescode
- ibeg=1
- lsecondary=.false.
- nhfrag=0
- nbfrag=0
- do i=1,10000
- read (ipdbin,'(a80)',end=10) card
- if (card(:5).eq.'HELIX') then
- nhfrag=nhfrag+1
- lsecondary=.true.
- read(card(22:25),*) hfrag(1,nhfrag)
- read(card(34:37),*) hfrag(2,nhfrag)
- endif
- if (card(:5).eq.'SHEET') then
- nbfrag=nbfrag+1
- lsecondary=.true.
- read(card(24:26),*) bfrag(1,nbfrag)
- read(card(35:37),*) bfrag(2,nbfrag)
-crc----------------------------------------
-crc to be corrected !!!
- bfrag(3,nbfrag)=bfrag(1,nbfrag)
- bfrag(4,nbfrag)=bfrag(2,nbfrag)
-crc----------------------------------------
- endif
- if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10
-C Fish out the ATOM cards.
- if (index(card(1:4),'ATOM').gt.0) then
- read (card(14:16),'(a3)') atom
- if (atom.eq.'CA' .or. atom.eq.'CH3') then
-C Calculate the CM of the preceding residue.
- if (ibeg.eq.0) then
- if (unres_pdb) then
- do j=1,3
- dc(j,ires+nres)=sccor(j,iii)
- enddo
- else
- call sccenter(ires,iii,sccor)
- endif
- endif
-C Start new residue.
- read (card(24:26),*) ires
- read (card(18:20),'(a3)') res
- if (ibeg.eq.1) then
- ishift=ires-1
- if (res.ne.'GLY' .and. res.ne. 'ACE') then
- ishift=ishift-1
- itype(1)=21
- endif
- ibeg=0
- endif
- ires=ires-ishift
- if (res.eq.'ACE') then
- ity=10
- else
- itype(ires)=rescode(ires,res,0)
- endif
- read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3)
-c if(me.eq.king.or..not.out1file)
-c & write (iout,'(2i3,2x,a,3f8.3)')
-c & ires,itype(ires),res,(c(j,ires),j=1,3)
- iii=1
- do j=1,3
- sccor(j,iii)=c(j,ires)
- enddo
- else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and.
- & atom.ne.'N ' .and. atom.ne.'C ') then
- iii=iii+1
- read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3)
- endif
- endif
- enddo
- 10 if(me.eq.king.or..not.out1file)
- & write (iout,'(a,i5)') ' Nres: ',ires
-C Calculate the CM of the last side chain.
- if (unres_pdb) then
- do j=1,3
- dc(j,ires+nres)=sccor(j,iii)
- enddo
- else
- call sccenter(ires,iii,sccor)
- endif
- nres=ires
- nsup=nres
- nstart_sup=1
- if (itype(nres).ne.10) then
- nres=nres+1
- itype(nres)=21
- if (unres_pdb) then
-C 2/15/2013 by Adam: corrected insertion of the last dummy residue
- call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail)
- if (fail) then
- e2(1)=0.0d0
- e2(2)=1.0d0
- e2(3)=0.0d0
- endif
- do j=1,3
- c(j,nres)=c(j,nres-1)-3.8d0*e2(j)
- enddo
- else
- do j=1,3
- dcj=c(j,nres-2)-c(j,nres-3)
- c(j,nres)=c(j,nres-1)+dcj
- c(j,2*nres)=c(j,nres)
- enddo
- endif
- endif
- do i=2,nres-1
- do j=1,3
- c(j,i+nres)=dc(j,i)
- enddo
- enddo
- do j=1,3
- c(j,nres+1)=c(j,1)
- c(j,2*nres)=c(j,nres)
- enddo
- if (itype(1).eq.21) then
- nsup=nsup-1
- nstart_sup=2
- if (unres_pdb) then
-C 2/15/2013 by Adam: corrected insertion of the first dummy residue
- call refsys(2,3,4,e1,e2,e3,fail)
- if (fail) then
- e2(1)=0.0d0
- e2(2)=1.0d0
- e2(3)=0.0d0
- endif
- do j=1,3
- c(j,1)=c(j,2)-3.8d0*e2(j)
- enddo
- else
- do j=1,3
- dcj=c(j,4)-c(j,3)
- c(j,1)=c(j,2)-dcj
- c(j,nres+1)=c(j,1)
- enddo
- endif
- endif
-C Calculate internal coordinates.
- if(me.eq.king.or..not.out1file)then
- write (iout,'(a)')
- & "Backbone and SC coordinates as read from the PDB"
- do ires=1,nres
- write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)')
- & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3),
- & (c(j,nres+ires),j=1,3)
- enddo
- endif
- call int_from_cart(.true.,.false.)
- call sc_loc_geom(.false.)
- do i=1,nres
- thetaref(i)=theta(i)
- phiref(i)=phi(i)
- enddo
- do i=1,nres-1
- do j=1,3
- dc(j,i)=c(j,i+1)-c(j,i)
- dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
- enddo
- enddo
- do i=2,nres-1
- do j=1,3
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
- enddo
-c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3),
-c & vbld_inv(i+nres)
- enddo
-c call chainbuild
-C Copy the coordinates to reference coordinates
- do i=1,2*nres
- do j=1,3
- cref(j,i)=c(j,i)
- enddo
- enddo
-
-
- do j=1,nbfrag
- do i=1,4
- bfrag(i,j)=bfrag(i,j)-ishift
- enddo
- enddo
-
- do j=1,nhfrag
- do i=1,2
- hfrag(i,j)=hfrag(i,j)-ishift
- enddo
- enddo
-
- return
- end
-c---------------------------------------------------------------------------
- subroutine int_from_cart(lside,lprn)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.NAMES'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- character*3 seq,atom,res
- character*80 card
- dimension sccor(3,20)
- integer rescode
- logical lside,lprn
- if(me.eq.king.or..not.out1file)then
- if (lprn) then
- write (iout,'(/a)')
- & 'Internal coordinates calculated from crystal structure.'
- if (lside) then
- write (iout,'(8a)') ' Res ',' dvb',' Theta',
- & ' Gamma',' Dsc_id',' Dsc',' Alpha',
- & ' Beta '
- else
- write (iout,'(4a)') ' Res ',' dvb',' Theta',
- & ' Gamma'
- endif
- endif
- endif
- do i=1,nres-1
- iti=itype(i)
- if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then
- write (iout,'(a,i4)') 'Bad Cartesians for residue',i
-ctest stop
- endif
- vbld(i+1)=dist(i,i+1)
- vbld_inv(i+1)=1.0d0/vbld(i+1)
- if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1)
- if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1)
- enddo
-c if (unres_pdb) then
-c if (itype(1).eq.21) then
-c theta(3)=90.0d0*deg2rad
-c phi(4)=180.0d0*deg2rad
-c vbld(2)=3.8d0
-c vbld_inv(2)=1.0d0/vbld(2)
-c endif
-c if (itype(nres).eq.21) then
-c theta(nres)=90.0d0*deg2rad
-c phi(nres)=180.0d0*deg2rad
-c vbld(nres)=3.8d0
-c vbld_inv(nres)=1.0d0/vbld(2)
-c endif
-c endif
- if (lside) then
- do i=2,nres-1
- do j=1,3
- c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i)
- & +(c(j,i+1)-c(j,i))*vbld_inv(i+1))
- enddo
- iti=itype(i)
- di=dist(i,nres+i)
-C 10/03/12 Adam: Correction for zero SC-SC bond length
- if (itype(i).ne.10 .and. itype(i).ne.21. and. di.eq.0.0d0)
- & di=dsc(itype(i))
- vbld(i+nres)=di
- if (itype(i).ne.10) then
- vbld_inv(i+nres)=1.0d0/di
- else
- vbld_inv(i+nres)=0.0d0
- endif
- if (iti.ne.10) then
- alph(i)=alpha(nres+i,i,maxres2)
- omeg(i)=beta(nres+i,i,maxres2,i+1)
- endif
- if(me.eq.king.or..not.out1file)then
- if (lprn)
- & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i),
- & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i),
- & rad2deg*alph(i),rad2deg*omeg(i)
- endif
- enddo
- else if (lprn) then
- do i=2,nres
- iti=itype(i)
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1),
- & rad2deg*theta(i),rad2deg*phi(i)
- enddo
- endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine sc_loc_geom(lprn)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.LOCAL'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.NAMES'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- double precision x_prime(3),y_prime(3),z_prime(3)
- logical lprn
- do i=1,nres-1
- do j=1,3
- dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i))
- enddo
- enddo
- do i=2,nres-1
- if (itype(i).ne.10) then
- do j=1,3
- dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i))
- enddo
- else
- do j=1,3
- dc_norm(j,i+nres)=0.0d0
- enddo
- endif
- enddo
- do i=2,nres-1
- costtab(i+1) =dcos(theta(i+1))
- sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
- cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
- sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
- cosfac2=0.5d0/(1.0d0+costtab(i+1))
- cosfac=dsqrt(cosfac2)
- sinfac2=0.5d0/(1.0d0-costtab(i+1))
- sinfac=dsqrt(sinfac2)
- it=itype(i)
- if (it.ne.10) then
-c
-C Compute the axes of tghe local cartesian coordinates system; store in
-c x_prime, y_prime and z_prime
-c
- do j=1,3
- x_prime(j) = 0.00
- y_prime(j) = 0.00
- z_prime(j) = 0.00
- enddo
- do j = 1,3
- x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
- y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
- enddo
- call vecpr(x_prime,y_prime,z_prime)
-c
-C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
-C to local coordinate system. Store in xx, yy, zz.
-c
- xx=0.0d0
- yy=0.0d0
- zz=0.0d0
- do j = 1,3
- xx = xx + x_prime(j)*dc_norm(j,i+nres)
- yy = yy + y_prime(j)*dc_norm(j,i+nres)
- zz = zz + z_prime(j)*dc_norm(j,i+nres)
- enddo
-
- xxref(i)=xx
- yyref(i)=yy
- zzref(i)=zz
- else
- xxref(i)=0.0d0
- yyref(i)=0.0d0
- zzref(i)=0.0d0
- endif
- enddo
- if (lprn) then
- do i=2,nres
- iti=itype(i)
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),
- & yyref(i),zzref(i)
- enddo
- endif
- return
- end
-c---------------------------------------------------------------------------
- subroutine sccenter(ires,nscat,sccor)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- dimension sccor(3,20)
- do j=1,3
- sccmj=0.0D0
- do i=1,nscat
- sccmj=sccmj+sccor(j,i)
- enddo
- dc(j,ires)=sccmj/nscat
- enddo
- return
- end
-c---------------------------------------------------------------------------
- subroutine bond_regular
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CALC'
- include 'COMMON.INTERACT'
- include 'COMMON.CHAIN'
- do i=1,nres-1
- vbld(i+1)=vbl
- vbld_inv(i+1)=1.0d0/vbld(i+1)
- vbld(i+1+nres)=dsc(itype(i+1))
- vbld_inv(i+1+nres)=dsc_inv(itype(i+1))
-c print *,vbld(i+1),vbld(i+1+nres)
- enddo
- return
- end
+++ /dev/null
- subroutine readrtns
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.IOUNITS'
- logical file_exist
-C Read force-field parameters except weights
- call parmread
-C Read job setup parameters
- call read_control
-C Read control parameters for energy minimzation if required
- if (minim) call read_minim
-C Read MCM control parameters if required
- if (modecalc.eq.3 .or. modecalc.eq.6) call mcmread
-C Read MD control parameters if reqjuired
- if (modecalc.eq.12) call read_MDpar
-C Read MREMD control parameters if required
- if (modecalc.eq.14) then
- call read_MDpar
- call read_REMDpar
- endif
-C Read MUCA control parameters if required
- if (lmuca) call read_muca
-C Read CSA control parameters if required (from fort.40 if exists
-C otherwise from general input file)
-csa if (modecalc.eq.8) then
-csa inquire (file="fort.40",exist=file_exist)
-csa if (.not.file_exist) call csaread
-csa endif
-cfmc if (modecalc.eq.10) call mcmfread
-C Read molecule information, molecule geometry, energy-term weights, and
-C restraints if requested
- call molread
-C Print restraint information
-#ifdef MPI
- if (.not. out1file .or. me.eq.king) then
-#endif
- if (nhpb.gt.nss)
- &write (iout,'(a,i5,a)') "The following",nhpb-nss,
- & " distance constraints have been imposed"
- do i=nss+1,nhpb
- write (iout,'(3i6,i2,3f10.5)') i-nss,ihpb(i),jhpb(i),
- & ibecarb(i),dhpb(i),dhpb1(i),forcon(i)
- enddo
-#ifdef MPI
- endif
-#endif
-c print *,"Processor",myrank," leaves READRTNS"
- return
- end
-C-------------------------------------------------------------------------------
- subroutine read_control
-C
-C Read contorl data
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MP
- include 'mpif.h'
- logical OKRandom, prng_restart
- real*8 r1
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.THREAD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.MCM'
- include 'COMMON.MAP'
- include 'COMMON.HEADER'
-csa include 'COMMON.CSA'
- include 'COMMON.CHAIN'
- include 'COMMON.MUCA'
- include 'COMMON.MD'
- include 'COMMON.FFIELD'
- include 'COMMON.SETUP'
- COMMON /MACHSW/ KDIAG,ICORFL,IXDR
- character*8 diagmeth(0:3) /'Library','EVVRSP','Givens','Jacobi'/
- character*80 ucase
- character*320 controlcard
-
- nglob_csa=0
- eglob_csa=1d99
- nmin_csa=0
- read (INP,'(a)') titel
- call card_concat(controlcard)
-c out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0
-c print *,"Processor",me," fg_rank",fg_rank," out1file",out1file
- call reada(controlcard,'SEED',seed,0.0D0)
- call random_init(seed)
-C Set up the time limit (caution! The time must be input in minutes!)
- read_cart=index(controlcard,'READ_CART').gt.0
- call readi(controlcard,'CONSTR_DIST',constr_dist,0)
- call readi(controlcard,'CONSTR_HOMOL',constr_homology,0)
- call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours
- unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0
- call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes
- call reada(controlcard,'RMSDBC',rmsdbc,3.0D0)
- call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0)
- call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0)
- call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0)
- call reada(controlcard,'DRMS',drms,0.1D0)
- if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
- write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc
- write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1
- write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max
- write (iout,'(a,f10.1)')'DRMS = ',drms
- write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm
- write (iout,'(a,f10.1)') 'Time limit (min):',timlim
- endif
- call readi(controlcard,'NZ_START',nz_start,0)
- call readi(controlcard,'NZ_END',nz_end,0)
- call readi(controlcard,'IZ_SC',iz_sc,0)
- timlim=60.0D0*timlim
- safety = 60.0d0*safety
- timem=timlim
- modecalc=0
- call reada(controlcard,"T_BATH",t_bath,300.0d0)
- minim=(index(controlcard,'MINIMIZE').gt.0)
- dccart=(index(controlcard,'CART').gt.0)
- overlapsc=(index(controlcard,'OVERLAP').gt.0)
- overlapsc=.not.overlapsc
- searchsc=(index(controlcard,'NOSEARCHSC').gt.0)
- searchsc=.not.searchsc
- sideadd=(index(controlcard,'SIDEADD').gt.0)
- energy_dec=(index(controlcard,'ENERGY_DEC').gt.0)
- outpdb=(index(controlcard,'PDBOUT').gt.0)
- outmol2=(index(controlcard,'MOL2OUT').gt.0)
- pdbref=(index(controlcard,'PDBREF').gt.0)
- refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0)
- indpdb=index(controlcard,'PDBSTART')
- extconf=(index(controlcard,'EXTCONF').gt.0)
- call readi(controlcard,'IPRINT',iprint,0)
- call readi(controlcard,'MAXGEN',maxgen,10000)
- call readi(controlcard,'MAXOVERLAP',maxoverlap,1000)
- call readi(controlcard,"KDIAG",kdiag,0)
- call readi(controlcard,"RESCALE_MODE",rescale_mode,2)
- if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0)
- & write (iout,*) "RESCALE_MODE",rescale_mode
- split_ene=index(controlcard,'SPLIT_ENE').gt.0
- if (index(controlcard,'REGULAR').gt.0.0D0) then
- call reada(controlcard,'WEIDIS',weidis,0.1D0)
- modecalc=1
- refstr=.true.
- endif
- if (index(controlcard,'CHECKGRAD').gt.0) then
- modecalc=5
- if (index(controlcard,'CART').gt.0) then
- icheckgrad=1
- elseif (index(controlcard,'CARINT').gt.0) then
- icheckgrad=2
- else
- icheckgrad=3
- endif
- elseif (index(controlcard,'THREAD').gt.0) then
- modecalc=2
- call readi(controlcard,'THREAD',nthread,0)
- if (nthread.gt.0) then
- call reada(controlcard,'WEIDIS',weidis,0.1D0)
- else
- if (fg_rank.eq.0)
- & write (iout,'(a)')'A number has to follow the THREAD keyword.'
- stop 'Error termination in Read_Control.'
- endif
- else if (index(controlcard,'MCMA').gt.0) then
- modecalc=3
- else if (index(controlcard,'MCEE').gt.0) then
- modecalc=6
- else if (index(controlcard,'MULTCONF').gt.0) then
- modecalc=4
- else if (index(controlcard,'MAP').gt.0) then
- modecalc=7
- call readi(controlcard,'MAP',nmap,0)
- else if (index(controlcard,'CSA').gt.0) then
- write(*,*) "CSA not supported in this version"
- stop
-csa modecalc=8
-crc else if (index(controlcard,'ZSCORE').gt.0) then
-crc
-crc ZSCORE is rm from UNRES, modecalc=9 is available
-crc
-crc modecalc=9
-cfcm else if (index(controlcard,'MCMF').gt.0) then
-cfmc modecalc=10
- else if (index(controlcard,'SOFTREG').gt.0) then
- modecalc=11
- else if (index(controlcard,'CHECK_BOND').gt.0) then
- modecalc=-1
- else if (index(controlcard,'TEST').gt.0) then
- modecalc=-2
- else if (index(controlcard,'MD').gt.0) then
- modecalc=12
- else if (index(controlcard,'RE ').gt.0) then
- modecalc=14
- endif
-
- lmuca=index(controlcard,'MUCA').gt.0
- call readi(controlcard,'MUCADYN',mucadyn,0)
- call readi(controlcard,'MUCASMOOTH',muca_smooth,0)
- if (lmuca .and. (me.eq.king .or. .not.out1file ))
- & then
- write (iout,*) 'MUCADYN=',mucadyn
- write (iout,*) 'MUCASMOOTH=',muca_smooth
- endif
-
- iscode=index(controlcard,'ONE_LETTER')
- indphi=index(controlcard,'PHI')
- indback=index(controlcard,'BACK')
- iranconf=index(controlcard,'RAND_CONF')
- i2ndstr=index(controlcard,'USE_SEC_PRED')
- gradout=index(controlcard,'GRADOUT').gt.0
- gnorm_check=index(controlcard,'GNORM_CHECK').gt.0
-
- if(me.eq.king.or..not.out1file)
- & write (iout,'(2a)') diagmeth(kdiag),
- & ' routine used to diagonalize matrices.'
- return
- end
-c--------------------------------------------------------------------------
- subroutine read_REMDpar
-C
-C Read REMD settings
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.REMD'
- include 'COMMON.CONTROL'
- include 'COMMON.SETUP'
- character*80 ucase
- character*320 controlcard
- character*3200 controlcard1
- integer iremd_m_total
-
- if(me.eq.king.or..not.out1file)
- & write (iout,*) "REMD setup"
-
- call card_concat(controlcard)
- call readi(controlcard,"NREP",nrep,3)
- call readi(controlcard,"NSTEX",nstex,1000)
- call reada(controlcard,"RETMIN",retmin,10.0d0)
- call reada(controlcard,"RETMAX",retmax,1000.0d0)
- mremdsync=(index(controlcard,'SYNC').gt.0)
- call readi(controlcard,"NSYN",i_sync_step,100)
- restart1file=(index(controlcard,'REST1FILE').gt.0)
- traj1file=(index(controlcard,'TRAJ1FILE').gt.0)
- call readi(controlcard,"TRAJCACHE",max_cache_traj_use,1)
- if(max_cache_traj_use.gt.max_cache_traj)
- & max_cache_traj_use=max_cache_traj
- if(me.eq.king.or..not.out1file) then
-cd if (traj1file) then
-crc caching is in testing - NTWX is not ignored
-cd write (iout,*) "NTWX value is ignored"
-cd write (iout,*) " trajectory is stored to one file by master"
-cd write (iout,*) " before exchange at NSTEX intervals"
-cd endif
- write (iout,*) "NREP= ",nrep
- write (iout,*) "NSTEX= ",nstex
- write (iout,*) "SYNC= ",mremdsync
- write (iout,*) "NSYN= ",i_sync_step
- write (iout,*) "TRAJCACHE= ",max_cache_traj_use
- endif
-
- t_exchange_only=(index(controlcard,'TONLY').gt.0)
- call readi(controlcard,"HREMD",hremd,0)
- if((me.eq.king.or..not.out1file).and.hremd.gt.0) then
- write (iout,*) "Hamiltonian REMD with ",hremd," sets of weights"
- endif
- if(usampl.and.hremd.gt.0) then
- write (iout,'(//a)')
- & "========== ERROR: USAMPL and HREMD cannot be used together"
-#ifdef MPI
- call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
-#endif
- stop
- endif
-
-
- remd_tlist=.false.
- if (index(controlcard,'TLIST').gt.0) then
- remd_tlist=.true.
- call card_concat(controlcard1)
- read(controlcard1,*) (remd_t(i),i=1,nrep)
- if(me.eq.king.or..not.out1file)
- & write (iout,*)'tlist',(remd_t(i),i=1,nrep)
- endif
- remd_mlist=.false.
- if (index(controlcard,'MLIST').gt.0) then
- remd_mlist=.true.
- call card_concat(controlcard1)
- read(controlcard1,*) (remd_m(i),i=1,nrep)
- if(me.eq.king.or..not.out1file) then
- write (iout,*)'mlist',(remd_m(i),i=1,nrep)
- iremd_m_total=0
- do i=1,nrep
- iremd_m_total=iremd_m_total+remd_m(i)
- enddo
- if(hremd.gt.1)then
- write (iout,*) 'Total number of replicas ',
- & iremd_m_total*hremd
- else
- write (iout,*) 'Total number of replicas ',iremd_m_total
- endif
- endif
- endif
- if(me.eq.king.or..not.out1file)
- & write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup "
- return
- end
-c--------------------------------------------------------------------------
- subroutine read_MDpar
-C
-C Read MD settings
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.SPLITELE'
- character*80 ucase
- character*320 controlcard
-
- call card_concat(controlcard)
- call readi(controlcard,"NSTEP",n_timestep,1000000)
- call readi(controlcard,"NTWE",ntwe,100)
- call readi(controlcard,"NTWX",ntwx,1000)
- call reada(controlcard,"DT",d_time,1.0d-1)
- call reada(controlcard,"DVMAX",dvmax,2.0d1)
- call reada(controlcard,"DAMAX",damax,1.0d1)
- call reada(controlcard,"EDRIFTMAX",edriftmax,1.0d+1)
- call readi(controlcard,"LANG",lang,0)
- RESPA = index(controlcard,"RESPA") .gt. 0
- call readi(controlcard,"NTIME_SPLIT",ntime_split,1)
- ntime_split0=ntime_split
- call readi(controlcard,"MAXTIME_SPLIT",maxtime_split,64)
- ntime_split0=ntime_split
- call reada(controlcard,"R_CUT",r_cut,2.0d0)
- call reada(controlcard,"LAMBDA",rlamb,0.3d0)
- rest = index(controlcard,"REST").gt.0
- tbf = index(controlcard,"TBF").gt.0
- call readi(controlcard,"HMC",hmc,0)
- tnp = index(controlcard,"NOSEPOINCARE99").gt.0
- tnp1 = index(controlcard,"NOSEPOINCARE01").gt.0
- tnh = index(controlcard,"NOSEHOOVER96").gt.0
- if (RESPA.and.tnh)then
- xiresp = index(controlcard,"XIRESP").gt.0
- endif
- call reada(controlcard,"Q_NP",Q_np,0.1d0)
- usampl = index(controlcard,"USAMPL").gt.0
-
- mdpdb = index(controlcard,"MDPDB").gt.0
- call reada(controlcard,"T_BATH",t_bath,300.0d0)
- call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1)
- call reada(controlcard,"EQ_TIME",eq_time,1.0d+4)
- call readi(controlcard,"RESET_MOMENT",count_reset_moment,1000)
- if (count_reset_moment.eq.0) count_reset_moment=1000000000
- call readi(controlcard,"RESET_VEL",count_reset_vel,1000)
- reset_moment=lang.eq.0 .and. tbf .and. count_reset_moment.gt.0
- reset_vel=lang.eq.0 .and. tbf .and. count_reset_vel.gt.0
- if (count_reset_vel.eq.0) count_reset_vel=1000000000
- large = index(controlcard,"LARGE").gt.0
- print_compon = index(controlcard,"PRINT_COMPON").gt.0
- rattle = index(controlcard,"RATTLE").gt.0
-c if performing umbrella sampling, fragments constrained are read from the fragment file
- nset=0
- if(usampl) then
- call read_fragments
- endif
-
- if(me.eq.king.or..not.out1file) then
- write (iout,*)
- write (iout,'(27(1h=),a26,27(1h=))') " Parameters of the MD run "
- write (iout,*)
- write (iout,'(a)') "The units are:"
- write (iout,'(a)') "positions: angstrom, time: 48.9 fs"
- write (iout,'(2a)') "velocity: angstrom/(48.9 fs),",
- & " acceleration: angstrom/(48.9 fs)**2"
- write (iout,'(a)') "energy: kcal/mol, temperature: K"
- write (iout,*)
- write (iout,'(a60,i10)') "Number of time steps:",n_timestep
- write (iout,'(a60,f10.5,a)')
- & "Initial time step of numerical integration:",d_time,
- & " natural units"
- write (iout,'(60x,f10.5,a)') d_time*48.9," fs"
- if (RESPA) then
- write (iout,'(2a,i4,a)')
- & "A-MTS algorithm used; initial time step for fast-varying",
- & " short-range forces split into",ntime_split," steps."
- write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff",
- & r_cut," lambda",rlamb
- endif
- write (iout,'(2a,f10.5)')
- & "Maximum acceleration threshold to reduce the time step",
- & "/increase split number:",damax
- write (iout,'(2a,f10.5)')
- & "Maximum predicted energy drift to reduce the timestep",
- & "/increase split number:",edriftmax
- write (iout,'(a60,f10.5)')
- & "Maximum velocity threshold to reduce velocities:",dvmax
- write (iout,'(a60,i10)') "Frequency of property output:",ntwe
- write (iout,'(a60,i10)') "Frequency of coordinate output:",ntwx
- if (rattle) write (iout,'(a60)')
- & "Rattle algorithm used to constrain the virtual bonds"
- endif
- reset_fricmat=1000
- if (lang.gt.0) then
- call reada(controlcard,"ETAWAT",etawat,0.8904d0)
- call reada(controlcard,"RWAT",rwat,1.4d0)
- call reada(controlcard,"SCAL_FRIC",scal_fric,2.0d-2)
- surfarea=index(controlcard,"SURFAREA").gt.0
- call readi(controlcard,"RESET_FRICMAT",reset_fricmat,1000)
- if(me.eq.king.or..not.out1file)then
- write (iout,'(/a,$)') "Langevin dynamics calculation"
- if (lang.eq.1) then
- write (iout,'(a/)')
- & " with direct integration of Langevin equations"
- else if (lang.eq.2) then
- write (iout,'(a/)') " with TINKER stochasic MD integrator"
- else if (lang.eq.3) then
- write (iout,'(a/)') " with Ciccotti's stochasic MD integrator"
- else if (lang.eq.4) then
- write (iout,'(a/)') " in overdamped mode"
- else
- write (iout,'(//a,i5)')
- & "=========== ERROR: Unknown Langevin dynamics mode:",lang
- stop
- endif
- write (iout,'(a60,f10.5)') "Temperature:",t_bath
- write (iout,'(a60,f10.5)') "Viscosity of the solvent:",etawat
- write (iout,'(a60,f10.5)') "Radius of solvent molecule:",rwat
- write (iout,'(a60,f10.5)')
- & "Scaling factor of the friction forces:",scal_fric
- if (surfarea) write (iout,'(2a,i10,a)')
- & "Friction coefficients will be scaled by solvent-accessible",
- & " surface area every",reset_fricmat," steps."
- endif
-c Calculate friction coefficients and bounds of stochastic forces
- eta=6*pi*cPoise*etawat
- if(me.eq.king.or..not.out1file)
- & write(iout,'(a60,f10.5)')"Eta of the solvent in natural units:"
- & ,eta
- gamp=scal_fric*(pstok+rwat)*eta
- stdfp=dsqrt(2*Rb*t_bath/d_time)
- do i=1,ntyp
- gamsc(i)=scal_fric*(restok(i)+rwat)*eta
- stdfsc(i)=dsqrt(2*Rb*t_bath/d_time)
- enddo
- if(me.eq.king.or..not.out1file)then
- write (iout,'(/2a/)')
- & "Radii of site types and friction coefficients and std's of",
- & " stochastic forces of fully exposed sites"
- write (iout,'(a5,f5.2,2f10.5)')'p',pstok,gamp,stdfp*dsqrt(gamp)
- do i=1,ntyp
- write (iout,'(a5,f5.2,2f10.5)') restyp(i),restok(i),
- & gamsc(i),stdfsc(i)*dsqrt(gamsc(i))
- enddo
- endif
- else if (tbf) then
- if(me.eq.king.or..not.out1file)then
- write (iout,'(a)') "Berendsen bath calculation"
- write (iout,'(a60,f10.5)') "Temperature:",t_bath
- write (iout,'(a60,f10.5)') "Coupling constant (tau):",tau_bath
- if (reset_moment)
- & write (iout,'(a,i10,a)') "Momenta will be reset at zero every",
- & count_reset_moment," steps"
- if (reset_vel)
- & write (iout,'(a,i10,a)')
- & "Velocities will be reset at random every",count_reset_vel,
- & " steps"
- endif
- else if (tnp .or. tnp1 .or. tnh) then
- if (tnp .or. tnp1) then
- write (iout,'(a)') "Nose-Poincare bath calculation"
- if (tnp) write (iout,'(a)')
- & "J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird"
- if (tnp1) write (iout,'(a)') "JPSJ 70 75 (2001) S. Nose"
- else
- write (iout,'(a)') "Nose-Hoover bath calculation"
- write (iout,'(a)') "Mol.Phys. 87 1117 (1996) Martyna et al."
- nresn=1
- nyosh=1
- nnos=1
- do i=1,nnos
- qmass(i)=Q_np
- xlogs(i)=1.0
- vlogs(i)=0.0
- enddo
- do i=1,nyosh
- WDTI(i) = 1.0*d_time/nresn
- WDTI2(i)=WDTI(i)/2
- WDTI4(i)=WDTI(i)/4
- WDTI8(i)=WDTI(i)/8
- enddo
- if (RESPA) then
- if(xiresp) then
- write (iout,'(a)') "NVT-XI-RESPA algorithm"
- else
- write (iout,'(a)') "NVT-XO-RESPA algorithm"
- endif
- do i=1,nyosh
- WDTIi(i) = 1.0*d_time/nresn/ntime_split
- WDTIi2(i)=WDTIi(i)/2
- WDTIi4(i)=WDTIi(i)/4
- WDTIi8(i)=WDTIi(i)/8
- enddo
- endif
- endif
-
- write (iout,'(a60,f10.5)') "Temperature:",t_bath
- write (iout,'(a60,f10.5)') "Q =",Q_np
- if (reset_moment)
- & write (iout,'(a,i10,a)') "Momenta will be reset at zero every",
- & count_reset_moment," steps"
- if (reset_vel)
- & write (iout,'(a,i10,a)')
- & "Velocities will be reset at random every",count_reset_vel,
- & " steps"
-
- else if (hmc.gt.0) then
- write (iout,'(a)') "Hybrid Monte Carlo calculation"
- write (iout,'(a60,f10.5)') "Temperature:",t_bath
- write (iout,'(a60,i10)')
- & "Number of MD steps between Metropolis tests:",hmc
-
- else
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a31)') "Microcanonical mode calculation"
- endif
- if(me.eq.king.or..not.out1file)then
- if (rest) write (iout,'(/a/)') "===== Calculation restarted ===="
- if (usampl) then
- write(iout,*) "MD running with constraints."
- write(iout,*) "Equilibration time ", eq_time, " mtus."
- write(iout,*) "Constraining ", nfrag," fragments."
- write(iout,*) "Length of each fragment, weight and q0:"
- do iset=1,nset
- write (iout,*) "Set of restraints #",iset
- do i=1,nfrag
- write(iout,'(2i5,f8.1,f7.4)') ifrag(1,i,iset),
- & ifrag(2,i,iset),wfrag(i,iset),qinfrag(i,iset)
- enddo
- write(iout,*) "constraints between ", npair, "fragments."
- write(iout,*) "constraint pairs, weights and q0:"
- do i=1,npair
- write(iout,'(2i5,f8.1,f7.4)') ipair(1,i,iset),
- & ipair(2,i,iset),wpair(i,iset),qinpair(i,iset)
- enddo
- write(iout,*) "angle constraints within ", nfrag_back,
- & "backbone fragments."
- write(iout,*) "fragment, weights:"
- do i=1,nfrag_back
- write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset),
- & ifrag_back(2,i,iset),wfrag_back(1,i,iset),
- & wfrag_back(2,i,iset),wfrag_back(3,i,iset)
- enddo
- enddo
- iset=mod(kolor,nset)+1
- endif
- endif
- if(me.eq.king.or..not.out1file)
- & write (iout,'(/30(1h=),a,29(1h=)/)') " End of MD run setup "
- return
- end
-c------------------------------------------------------------------------------
- subroutine molread
-C
-C Read molecular data.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- integer error_msg
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.CONTACTS'
- include 'COMMON.TORCNSTR'
- include 'COMMON.TIME1'
- include 'COMMON.BOUNDS'
- include 'COMMON.MD'
- include 'COMMON.REMD'
- include 'COMMON.SETUP'
- character*4 sequence(maxres)
- integer rescode
- double precision x(maxvar)
- character*256 pdbfile
- character*320 weightcard
- character*80 weightcard_t,ucase
- dimension itype_pdb(maxres)
- common /pizda/ itype_pdb
- logical seq_comp,fail
- double precision energia(0:n_ene)
- integer ilen
- external ilen
-C
-C Body
-C
-C Read weights of the subsequent energy terms.
- if(hremd.gt.0) then
-
- k=0
- do il=1,hremd
- do i=1,nrep
- do j=1,remd_m(i)
- i2set(k)=il
- k=k+1
- enddo
- enddo
- enddo
-
- if(me.eq.king.or..not.out1file) then
- write (iout,*) 'Reading ',hremd,' sets of weights for HREMD'
- write (iout,*) 'Current weights for processor ',
- & me,' set ',i2set(me)
- endif
-
- do i=1,hremd
- call card_concat(weightcard)
- call reada(weightcard,'WLONG',wlong,1.0D0)
- call reada(weightcard,'WSC',wsc,wlong)
- call reada(weightcard,'WSCP',wscp,wlong)
- call reada(weightcard,'WELEC',welec,1.0D0)
- call reada(weightcard,'WVDWPP',wvdwpp,welec)
- call reada(weightcard,'WEL_LOC',wel_loc,1.0D0)
- call reada(weightcard,'WCORR4',wcorr4,0.0D0)
- call reada(weightcard,'WCORR5',wcorr5,0.0D0)
- call reada(weightcard,'WCORR6',wcorr6,0.0D0)
- call reada(weightcard,'WTURN3',wturn3,1.0D0)
- call reada(weightcard,'WTURN4',wturn4,1.0D0)
- call reada(weightcard,'WTURN6',wturn6,1.0D0)
- call reada(weightcard,'WSCCOR',wsccor,1.0D0)
- call reada(weightcard,'WSTRAIN',wstrain,1.0D0)
- call reada(weightcard,'WBOND',wbond,1.0D0)
- call reada(weightcard,'WTOR',wtor,1.0D0)
- call reada(weightcard,'WTORD',wtor_d,1.0D0)
- call reada(weightcard,'WANG',wang,1.0D0)
- call reada(weightcard,'WSCLOC',wscloc,1.0D0)
- call reada(weightcard,'SCAL14',scal14,0.4D0)
- call reada(weightcard,'SCALSCP',scalscp,1.0d0)
- call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
- call reada(weightcard,'DELT_CORR',delt_corr,0.5d0)
- call reada(weightcard,'TEMP0',temp0,300.0d0)
- if (index(weightcard,'SOFT').gt.0) ipot=6
-C 12/1/95 Added weight for the multi-body term WCORR
- call reada(weightcard,'WCORRH',wcorr,1.0D0)
- if (wcorr4.gt.0.0d0) wcorr=wcorr4
-
- hweights(i,1)=wsc
- hweights(i,2)=wscp
- hweights(i,3)=welec
- hweights(i,4)=wcorr
- hweights(i,5)=wcorr5
- hweights(i,6)=wcorr6
- hweights(i,7)=wel_loc
- hweights(i,8)=wturn3
- hweights(i,9)=wturn4
- hweights(i,10)=wturn6
- hweights(i,11)=wang
- hweights(i,12)=wscloc
- hweights(i,13)=wtor
- hweights(i,14)=wtor_d
- hweights(i,15)=wstrain
- hweights(i,16)=wvdwpp
- hweights(i,17)=wbond
- hweights(i,18)=scal14
- hweights(i,21)=wsccor
-
- enddo
-
- do i=1,n_ene
- weights(i)=hweights(i2set(me),i)
- enddo
- wsc =weights(1)
- wscp =weights(2)
- welec =weights(3)
- wcorr =weights(4)
- wcorr5 =weights(5)
- wcorr6 =weights(6)
- wel_loc=weights(7)
- wturn3 =weights(8)
- wturn4 =weights(9)
- wturn6 =weights(10)
- wang =weights(11)
- wscloc =weights(12)
- wtor =weights(13)
- wtor_d =weights(14)
- wstrain=weights(15)
- wvdwpp =weights(16)
- wbond =weights(17)
- scal14 =weights(18)
- wsccor =weights(21)
-
-
- else
- call card_concat(weightcard)
- call reada(weightcard,'WLONG',wlong,1.0D0)
- call reada(weightcard,'WSC',wsc,wlong)
- call reada(weightcard,'WSCP',wscp,wlong)
- call reada(weightcard,'WELEC',welec,1.0D0)
- call reada(weightcard,'WVDWPP',wvdwpp,welec)
- call reada(weightcard,'WEL_LOC',wel_loc,1.0D0)
- call reada(weightcard,'WCORR4',wcorr4,0.0D0)
- call reada(weightcard,'WCORR5',wcorr5,0.0D0)
- call reada(weightcard,'WCORR6',wcorr6,0.0D0)
- call reada(weightcard,'WTURN3',wturn3,1.0D0)
- call reada(weightcard,'WTURN4',wturn4,1.0D0)
- call reada(weightcard,'WTURN6',wturn6,1.0D0)
- call reada(weightcard,'WSCCOR',wsccor,1.0D0)
- call reada(weightcard,'WSTRAIN',wstrain,1.0D0)
- call reada(weightcard,'WBOND',wbond,1.0D0)
- call reada(weightcard,'WTOR',wtor,1.0D0)
- call reada(weightcard,'WTORD',wtor_d,1.0D0)
- call reada(weightcard,'WANG',wang,1.0D0)
- call reada(weightcard,'WSCLOC',wscloc,1.0D0)
- call reada(weightcard,'SCAL14',scal14,0.4D0)
- call reada(weightcard,'SCALSCP',scalscp,1.0d0)
- call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0)
- call reada(weightcard,'DELT_CORR',delt_corr,0.5d0)
- call reada(weightcard,'TEMP0',temp0,300.0d0)
- if (index(weightcard,'SOFT').gt.0) ipot=6
-C 12/1/95 Added weight for the multi-body term WCORR
- call reada(weightcard,'WCORRH',wcorr,1.0D0)
- if (wcorr4.gt.0.0d0) wcorr=wcorr4
- weights(1)=wsc
- weights(2)=wscp
- weights(3)=welec
- weights(4)=wcorr
- weights(5)=wcorr5
- weights(6)=wcorr6
- weights(7)=wel_loc
- weights(8)=wturn3
- weights(9)=wturn4
- weights(10)=wturn6
- weights(11)=wang
- weights(12)=wscloc
- weights(13)=wtor
- weights(14)=wtor_d
- weights(15)=wstrain
- weights(16)=wvdwpp
- weights(17)=wbond
- weights(18)=scal14
- weights(21)=wsccor
- endif
-
- if(me.eq.king.or..not.out1file)
- & write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,
- & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3,
- & wturn4,wturn6
- 10 format (/'Energy-term weights (unscaled):'//
- & 'WSCC= ',f10.6,' (SC-SC)'/
- & 'WSCP= ',f10.6,' (SC-p)'/
- & 'WELEC= ',f10.6,' (p-p electr)'/
- & 'WVDWPP= ',f10.6,' (p-p VDW)'/
- & 'WBOND= ',f10.6,' (stretching)'/
- & 'WANG= ',f10.6,' (bending)'/
- & 'WSCLOC= ',f10.6,' (SC local)'/
- & 'WTOR= ',f10.6,' (torsional)'/
- & 'WTORD= ',f10.6,' (double torsional)'/
- & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/
- & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/
- & 'WCORR4= ',f10.6,' (multi-body 4th order)'/
- & 'WCORR5= ',f10.6,' (multi-body 5th order)'/
- & 'WCORR6= ',f10.6,' (multi-body 6th order)'/
- & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/
- & 'WTURN3= ',f10.6,' (turns, 3rd order)'/
- & 'WTURN4= ',f10.6,' (turns, 4th order)'/
- & 'WTURN6= ',f10.6,' (turns, 6th order)')
- if(me.eq.king.or..not.out1file)then
- if (wcorr4.gt.0.0d0) then
- write (iout,'(/2a/)') 'Local-electrostatic type correlation ',
- & 'between contact pairs of peptide groups'
- write (iout,'(2(a,f5.3/))')
- & 'Cutoff on 4-6th order correlation terms: ',cutoff_corr,
- & 'Range of quenching the correlation terms:',2*delt_corr
- else if (wcorr.gt.0.0d0) then
- write (iout,'(/2a/)') 'Hydrogen-bonding correlation ',
- & 'between contact pairs of peptide groups'
- endif
- write (iout,'(a,f8.3)')
- & 'Scaling factor of 1,4 SC-p interactions:',scal14
- write (iout,'(a,f8.3)')
- & 'General scaling factor of SC-p interactions:',scalscp
- endif
- r0_corr=cutoff_corr-delt_corr
- do i=1,20
- aad(i,1)=scalscp*aad(i,1)
- aad(i,2)=scalscp*aad(i,2)
- bad(i,1)=scalscp*bad(i,1)
- bad(i,2)=scalscp*bad(i,2)
- enddo
- call rescale_weights(t_bath)
- if(me.eq.king.or..not.out1file)
- & write (iout,22) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor,
- & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3,
- & wturn4,wturn6
- 22 format (/'Energy-term weights (scaled):'//
- & 'WSCC= ',f10.6,' (SC-SC)'/
- & 'WSCP= ',f10.6,' (SC-p)'/
- & 'WELEC= ',f10.6,' (p-p electr)'/
- & 'WVDWPP= ',f10.6,' (p-p VDW)'/
- & 'WBOND= ',f10.6,' (stretching)'/
- & 'WANG= ',f10.6,' (bending)'/
- & 'WSCLOC= ',f10.6,' (SC local)'/
- & 'WTOR= ',f10.6,' (torsional)'/
- & 'WTORD= ',f10.6,' (double torsional)'/
- & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/
- & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/
- & 'WCORR4= ',f10.6,' (multi-body 4th order)'/
- & 'WCORR5= ',f10.6,' (multi-body 5th order)'/
- & 'WCORR6= ',f10.6,' (multi-body 6th order)'/
- & 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/
- & 'WTURN3= ',f10.6,' (turns, 3rd order)'/
- & 'WTURN4= ',f10.6,' (turns, 4th order)'/
- & 'WTURN6= ',f10.6,' (turns, 6th order)')
- if(me.eq.king.or..not.out1file)
- & write (iout,*) "Reference temperature for weights calculation:",
- & temp0
- call reada(weightcard,"D0CM",d0cm,3.78d0)
- call reada(weightcard,"AKCM",akcm,15.1d0)
- call reada(weightcard,"AKTH",akth,11.0d0)
- call reada(weightcard,"AKCT",akct,12.0d0)
- call reada(weightcard,"V1SS",v1ss,-1.08d0)
- call reada(weightcard,"V2SS",v2ss,7.61d0)
- call reada(weightcard,"V3SS",v3ss,13.7d0)
- call reada(weightcard,"EBR",ebr,-5.50D0)
- dyn_ss=(index(weightcard,'DYN_SS').gt.0)
- do i=1,maxres
- dyn_ss_mask(i)=.false.
- enddo
- do i=1,maxres-1
- do j=i+1,maxres
- dyn_ssbond_ij(i,j)=1.0d300
- enddo
- enddo
- call reada(weightcard,"HT",Ht,0.0D0)
- if (dyn_ss) then
- ss_depth=ebr/wsc-0.25*eps(1,1)
- Ht=Ht/wsc-0.25*eps(1,1)
- akcm=akcm*wstrain/wsc
- akth=akth*wstrain/wsc
- akct=akct*wstrain/wsc
- v1ss=v1ss*wstrain/wsc
- v2ss=v2ss*wstrain/wsc
- v3ss=v3ss*wstrain/wsc
- else
- ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain
- endif
-
- if(me.eq.king.or..not.out1file) then
- write (iout,*) "Parameters of the SS-bond potential:"
- write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth,
- & " AKCT",akct
- write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss
- write (iout,*) "EBR",ebr," SS_DEPTH",ss_depth
- write (iout,*)" HT",Ht
- print *,'indpdb=',indpdb,' pdbref=',pdbref
- endif
- if (indpdb.gt.0 .or. pdbref) then
- read(inp,'(a)') pdbfile
- if(me.eq.king.or..not.out1file)
- & write (iout,'(2a)') 'PDB data will be read from file ',
- & pdbfile(:ilen(pdbfile))
- open(ipdbin,file=pdbfile,status='old',err=33)
- goto 34
- 33 write (iout,'(a)') 'Error opening PDB file.'
- stop
- 34 continue
-c print *,'Begin reading pdb data'
- call readpdb
-c print *,'Finished reading pdb data'
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a,i3,a,i3)')'nsup=',nsup,
- & ' nstart_sup=',nstart_sup
- do i=1,nres
- itype_pdb(i)=itype(i)
- enddo
- close (ipdbin)
- nnt=nstart_sup
- nct=nstart_sup+nsup-1
- call contact(.false.,ncont_ref,icont_ref,co)
-
- if (sideadd) then
-C Following 2 lines for diagnostics; comment out if not needed
- write (iout,*) "Before sideadd"
- call intout
- if(me.eq.king.or..not.out1file)
- & write(iout,*)'Adding sidechains'
- maxsi=1000
- do i=2,nres-1
- iti=itype(i)
- if (iti.ne.10) then
- nsi=0
- fail=.true.
- do while (fail.and.nsi.le.maxsi)
- call gen_side(iti,theta(i+1),alph(i),omeg(i),fail)
- nsi=nsi+1
- enddo
- if(fail) write(iout,*)'Adding sidechain failed for res ',
- & i,' after ',nsi,' trials'
- endif
- enddo
-C 10/03/12 Adam: Recalculate coordinates with new side chain positions
- call chainbuild
- endif
-C Following 2 lines for diagnostics; comment out if not needed
-c write (iout,*) "After sideadd"
-c call intout
- endif
- if (indpdb.eq.0) then
-C Read sequence if not taken from the pdb file.
- read (inp,*) nres
-c print *,'nres=',nres
- if (iscode.gt.0) then
- read (inp,'(80a1)') (sequence(i)(1:1),i=1,nres)
- else
- read (inp,'(20(1x,a3))') (sequence(i),i=1,nres)
- endif
-C Convert sequence to numeric code
- do i=1,nres
- itype(i)=rescode(i,sequence(i),iscode)
- enddo
-C Assign initial virtual bond lengths
- do i=2,nres
- vbld(i)=vbl
- vbld_inv(i)=vblinv
- enddo
- do i=2,nres-1
- vbld(i+nres)=dsc(itype(i))
- vbld_inv(i+nres)=dsc_inv(itype(i))
-c write (iout,*) "i",i," itype",itype(i),
-c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres)
- enddo
- endif
-c print *,nres
-c print '(20i4)',(itype(i),i=1,nres)
- do i=1,nres
-#ifdef PROCOR
- if (itype(i).eq.21 .or. itype(i+1).eq.21) then
-#else
- if (itype(i).eq.21) then
-#endif
- itel(i)=0
-#ifdef PROCOR
- else if (itype(i+1).ne.20) then
-#else
- else if (itype(i).ne.20) then
-#endif
- itel(i)=1
- else
- itel(i)=2
- endif
- enddo
- if(me.eq.king.or..not.out1file)then
- write (iout,*) "ITEL"
- do i=1,nres-1
- write (iout,*) i,itype(i),itel(i)
- enddo
- print *,'Call Read_Bridge.'
- endif
- call read_bridge
-C 8/13/98 Set limits to generating the dihedral angles
- do i=1,nres
- phibound(1,i)=-pi
- phibound(2,i)=pi
- enddo
- read (inp,*) ndih_constr
- if (ndih_constr.gt.0) then
- read (inp,*) ftors
- read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr)
- if(me.eq.king.or..not.out1file)then
- write (iout,*)
- & 'There are',ndih_constr,' constraints on phi angles.'
- do i=1,ndih_constr
- write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i)
- enddo
- endif
- do i=1,ndih_constr
- phi0(i)=deg2rad*phi0(i)
- drange(i)=deg2rad*drange(i)
- enddo
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'FTORS',ftors
- do i=1,ndih_constr
- ii = idih_constr(i)
- phibound(1,ii) = phi0(i)-drange(i)
- phibound(2,ii) = phi0(i)+drange(i)
- enddo
- endif
- nnt=1
-#ifdef MPI
- if (me.eq.king) then
-#endif
- write (iout,'(a)') 'Boundaries in phi angle sampling:'
- do i=1,nres
- write (iout,'(a3,i5,2f10.1)')
- & restyp(itype(i)),i,phibound(1,i)*rad2deg,phibound(2,i)*rad2deg
- enddo
-#ifdef MP
- endif
-#endif
- nct=nres
-cd print *,'NNT=',NNT,' NCT=',NCT
- if (itype(1).eq.21) nnt=2
- if (itype(nres).eq.21) nct=nct-1
- if (pdbref) then
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a,i3)') 'nsup=',nsup
- nstart_seq=nnt
- if (nsup.le.(nct-nnt+1)) then
- do i=0,nct-nnt+1-nsup
- if (seq_comp(itype(nnt+i),itype_pdb(nstart_sup),nsup)) then
- nstart_seq=nnt+i
- goto 111
- endif
- enddo
- write (iout,'(a)')
- & 'Error - sequences to be superposed do not match.'
- stop
- else
- do i=0,nsup-(nct-nnt+1)
- if (seq_comp(itype(nnt),itype_pdb(nstart_sup+i),nct-nnt+1))
- & then
- nstart_sup=nstart_sup+i
- nsup=nct-nnt+1
- goto 111
- endif
- enddo
- write (iout,'(a)')
- & 'Error - sequences to be superposed do not match.'
- endif
- 111 continue
- if (nsup.eq.0) nsup=nct-nnt
- if (nstart_sup.eq.0) nstart_sup=nnt
- if (nstart_seq.eq.0) nstart_seq=nnt
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'nsup=',nsup,' nstart_sup=',nstart_sup,
- & ' nstart_seq=',nstart_seq
- endif
-c--- Zscore rms -------
- if (nz_start.eq.0) nz_start=nnt
- if (nz_end.eq.0 .and. nsup.gt.0) then
- nz_end=nnt+nsup-1
- else if (nz_end.eq.0) then
- nz_end=nct
- endif
- if(me.eq.king.or..not.out1file)then
- write (iout,*) 'NZ_START=',nz_start,' NZ_END=',nz_end
- write (iout,*) 'IZ_SC=',iz_sc
- endif
-c----------------------
- call init_int_table
- if (refstr) then
- if (.not.pdbref) then
- call read_angles(inp,*38)
- goto 39
- 38 write (iout,'(a)') 'Error reading reference structure.'
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERROR)
- stop 'Error reading reference structure'
-#endif
- 39 call chainbuild
- call setup_var
-czscore call geom_to_var(nvar,coord_exp_zs(1,1))
- nstart_sup=nnt
- nstart_seq=nnt
- nsup=nct-nnt+1
- do i=1,2*nres
- do j=1,3
- cref(j,i)=c(j,i)
- enddo
- enddo
- call contact(.true.,ncont_ref,icont_ref,co)
- endif
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'Contact order:',co
- if (pdbref) then
- if(me.eq.king.or..not.out1file)
- & write (2,*) 'Shifting contacts:',nstart_seq,nstart_sup
- do i=1,ncont_ref
- do j=1,2
- icont_ref(j,i)=icont_ref(j,i)+nstart_seq-nstart_sup
- enddo
- if(me.eq.king.or..not.out1file)
- & write (2,*) i,' ',restyp(itype(icont_ref(1,i))),' ',
- & icont_ref(1,i),' ',
- & restyp(itype(icont_ref(2,i))),' ',icont_ref(2,i)
- enddo
- endif
- endif
-c write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup
- if (constr_dist.gt.0) then
- call read_dist_constr
- endif
-
-
- if (constr_homology.gt.0) then
- call read_constr_homology
- endif
-
-
- if (nhpb.gt.0) call hpb_partition
-c write (iout,*) "After read_dist_constr nhpb",nhpb
-c call flush(iout)
- if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4
- & .and. modecalc.ne.8 .and. modecalc.ne.9 .and.
- & modecalc.ne.10) then
-C If input structure hasn't been supplied from the PDB file read or generate
-C initial geometry.
- if (iranconf.eq.0 .and. .not. extconf) then
- if(me.eq.king.or..not.out1file .and.fg_rank.eq.0)
- & write (iout,'(a)') 'Initial geometry will be read in.'
- if (read_cart) then
- read(inp,'(8f10.5)',end=36,err=36)
- & ((c(l,k),l=1,3),k=1,nres),
- & ((c(l,k+nres),l=1,3),k=nnt,nct)
- call int_from_cart1(.false.)
- do i=1,nres-1
- do j=1,3
- dc(j,i)=c(j,i+1)-c(j,i)
- dc_norm(j,i)=dc_norm(j,i)*vbld_inv(i+1)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i+nres)=dc_norm(j,i+nres)*vbld_inv(i+nres)
- enddo
- endif
- enddo
- return
- else
- call read_angles(inp,*36)
- endif
- goto 37
- 36 write (iout,'(a)') 'Error reading angle file.'
-#ifdef MPI
- call mpi_finalize( MPI_COMM_WORLD,IERR )
-#endif
- stop 'Error reading angle file.'
- 37 continue
- else if (extconf) then
- if(me.eq.king.or..not.out1file .and. fg_rank.eq.0)
- & write (iout,'(a)') 'Extended chain initial geometry.'
- do i=3,nres
- theta(i)=90d0*deg2rad
- enddo
- do i=4,nres
- phi(i)=180d0*deg2rad
- enddo
- do i=2,nres-1
- alph(i)=110d0*deg2rad
- enddo
- do i=2,nres-1
- omeg(i)=-120d0*deg2rad
- enddo
- else
- if(me.eq.king.or..not.out1file)
- & write (iout,'(a)') 'Random-generated initial geometry.'
-
-
-#ifdef MPI
- if (me.eq.king .or. fg_rank.eq.0 .and. (
- & modecalc.eq.12 .or. modecalc.eq.14) ) then
-#endif
- do itrial=1,100
- itmp=1
- call gen_rand_conf(itmp,*30)
- goto 40
- 30 write (iout,*) 'Failed to generate random conformation',
- & ', itrial=',itrial
- write (*,*) 'Processor:',me,
- & ' Failed to generate random conformation',
- & ' itrial=',itrial
- call intout
-
-#ifdef AIX
- call flush_(iout)
-#else
- call flush(iout)
-#endif
- enddo
- write (iout,'(a,i3,a)') 'Processor:',me,
- & ' error in generating random conformation.'
- write (*,'(a,i3,a)') 'Processor:',me,
- & ' error in generating random conformation.'
- call flush(iout)
-#ifdef MPI
- call MPI_Abort(mpi_comm_world,error_msg,ierrcode)
- 40 continue
- endif
-#else
- 40 continue
-#endif
- endif
- elseif (modecalc.eq.4) then
- read (inp,'(a)') intinname
- open (intin,file=intinname,status='old',err=333)
- if (me.eq.king .or. .not.out1file.and.fg_rank.eq.0)
- & write (iout,'(a)') 'intinname',intinname
- write (*,'(a)') 'Processor',myrank,' intinname',intinname
- goto 334
- 333 write (iout,'(2a)') 'Error opening angle file ',intinname
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,IERR)
-#endif
- stop 'Error opening angle file.'
- 334 continue
-
- endif
-C Generate distance constraints, if the PDB structure is to be regularized.
- if (nthread.gt.0) then
- call read_threadbase
- endif
- call setup_var
- if (me.eq.king .or. .not. out1file)
- & call intout
- if (ns.gt.0 .and. (me.eq.king .or. .not.out1file) ) then
- write (iout,'(/a,i3,a)')
- & 'The chain contains',ns,' disulfide-bridging cysteines.'
- write (iout,'(20i4)') (iss(i),i=1,ns)
- if (dyn_ss) then
- write(iout,*)"Running with dynamic disulfide-bond formation"
- else
- write (iout,'(/a/)') 'Pre-formed links are:'
- do i=1,nss
- i1=ihpb(i)-nres
- i2=jhpb(i)-nres
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(2a,i3,3a,i3,a,3f10.3)')
- & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i),
- & ebr,forcon(i)
- enddo
- write (iout,'(a)')
- endif
- endif
- if (ns.gt.0.and.dyn_ss) then
- do i=nss+1,nhpb
- ihpb(i-nss)=ihpb(i)
- jhpb(i-nss)=jhpb(i)
- forcon(i-nss)=forcon(i)
- dhpb(i-nss)=dhpb(i)
- enddo
- nhpb=nhpb-nss
- nss=0
- call hpb_partition
- do i=1,ns
- dyn_ss_mask(iss(i))=.true.
- enddo
- endif
- if (i2ndstr.gt.0) call secstrp2dihc
-c call geom_to_var(nvar,x)
-c call etotal(energia(0))
-c call enerprint(energia(0))
-c call briefout(0,etot)
-c stop
-cd write (iout,'(2(a,i3))') 'NNT',NNT,' NCT',NCT
-cd write (iout,'(a)') 'Variable list:'
-cd write (iout,'(i4,f10.5)') (i,rad2deg*x(i),i=1,nvar)
-#ifdef MPI
- if (me.eq.king .or. (fg_rank.eq.0 .and. .not.out1file))
- & write (iout,'(//80(1h*)/20x,a,i4,a/80(1h*)//)')
- & 'Processor',myrank,': end reading molecular data.'
-#endif
- return
- end
-c--------------------------------------------------------------------------
- logical function seq_comp(itypea,itypeb,length)
- implicit none
- integer length,itypea(length),itypeb(length)
- integer i
- do i=1,length
- if (itypea(i).ne.itypeb(i)) then
- seq_comp=.false.
- return
- endif
- enddo
- seq_comp=.true.
- return
- end
-c-----------------------------------------------------------------------------
- subroutine read_bridge
-C Read information about disulfide bridges.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.TIME1'
- include 'COMMON.SETUP'
-C Read bridging residues.
- read (inp,*) ns,(iss(i),i=1,ns)
- print *,'ns=',ns
- if(me.eq.king.or..not.out1file)
- & write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns)
-C Check whether the specified bridging residues are cystines.
- do i=1,ns
- if (itype(iss(i)).ne.1) then
- if (me.eq.king.or..not.out1file) write (iout,'(2a,i3,a)')
- & 'Do you REALLY think that the residue ',
- & restyp(itype(iss(i))),i,
- & ' can form a disulfide bridge?!!!'
- write (*,'(2a,i3,a)')
- & 'Do you REALLY think that the residue ',
- & restyp(itype(iss(i))),i,
- & ' can form a disulfide bridge?!!!'
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,ierror)
- stop
-#endif
- endif
- enddo
-C Read preformed bridges.
- if (ns.gt.0) then
- read (inp,*) nss,(ihpb(i),jhpb(i),i=1,nss)
- if(fg_rank.eq.0)
- & write(iout,*)'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss)
- if (nss.gt.0) then
- nhpb=nss
-C Check if the residues involved in bridges are in the specified list of
-C bridging residues.
- do i=1,nss
- do j=1,i-1
- if (ihpb(i).eq.ihpb(j).or.ihpb(i).eq.jhpb(j)
- & .or.jhpb(i).eq.ihpb(j).or.jhpb(i).eq.jhpb(j)) then
- write (iout,'(a,i3,a)') 'Disulfide pair',i,
- & ' contains residues present in other pairs.'
- write (*,'(a,i3,a)') 'Disulfide pair',i,
- & ' contains residues present in other pairs.'
-#ifdef MPI
- call MPI_Finalize(MPI_COMM_WORLD,ierror)
- stop
-#endif
- endif
- enddo
- do j=1,ns
- if (ihpb(i).eq.iss(j)) goto 10
- enddo
- write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.'
- 10 continue
- do j=1,ns
- if (jhpb(i).eq.iss(j)) goto 20
- enddo
- write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.'
- 20 continue
- dhpb(i)=dbr
- forcon(i)=fbr
- enddo
- do i=1,nss
- ihpb(i)=ihpb(i)+nres
- jhpb(i)=jhpb(i)+nres
- enddo
- endif
- endif
- return
- end
-c----------------------------------------------------------------------------
- subroutine read_x(kanal,*)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
-c Read coordinates from input
-c
- read(kanal,'(8f10.5)',end=10,err=10)
- & ((c(l,k),l=1,3),k=1,nres),
- & ((c(l,k+nres),l=1,3),k=nnt,nct)
- do j=1,3
- c(j,nres+1)=c(j,1)
- c(j,2*nres)=c(j,nres)
- enddo
- call int_from_cart1(.false.)
- do i=1,nres-1
- do j=1,3
- dc(j,i)=c(j,i+1)-c(j,i)
- dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
- enddo
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- dc(j,i+nres)=c(j,i+nres)-c(j,i)
- dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
- enddo
- endif
- enddo
-
- return
- 10 return1
- end
-c----------------------------------------------------------------------------
- subroutine read_threadbase
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.TIME1'
-C Read pattern database for threading.
- read (icbase,*) nseq
- do i=1,nseq
- read (icbase,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i),
- & nres_base(2,i),nres_base(3,i)
- read (icbase,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1,
- & nres_base(1,i))
-c write (iout,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i),
-c & nres_base(2,i),nres_base(3,i)
-c write (iout,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1,
-c & nres_base(1,i))
- enddo
- close (icbase)
- if (weidis.eq.0.0D0) weidis=0.1D0
- do i=nnt,nct
- do j=i+2,nct
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=weidis
- enddo
- enddo
- read (inp,*) nexcl,(iexam(1,i),iexam(2,i),i=1,nexcl)
- write (iout,'(a,i5)') 'nexcl: ',nexcl
- write (iout,'(2i5)') (iexam(1,i),iexam(2,i),i=1,nexcl)
- return
- end
-c------------------------------------------------------------------------------
- subroutine setup_var
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.TIME1'
-C Set up variable list.
- ntheta=nres-2
- nphi=nres-3
- nvar=ntheta+nphi
- nside=0
- do i=2,nres-1
- if (itype(i).ne.10) then
- nside=nside+1
- ialph(i,1)=nvar+nside
- ialph(nside,2)=i
- endif
- enddo
- if (indphi.gt.0) then
- nvar=nphi
- else if (indback.gt.0) then
- nvar=nphi+ntheta
- else
- nvar=nvar+2*nside
- endif
-cd write (iout,'(3i4)') (i,ialph(i,1),ialph(i,2),i=2,nres-1)
- return
- end
-c----------------------------------------------------------------------------
- subroutine gen_dist_constr
-C Generate CA distance constraints.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.LOCAL'
- include 'COMMON.NAMES'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.DBASE'
- include 'COMMON.THREAD'
- include 'COMMON.TIME1'
- dimension itype_pdb(maxres)
- common /pizda/ itype_pdb
- character*2 iden
-cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct
-cd write (2,*) 'gen_dist_constr: nnt=',nnt,' nct=',nct,
-cd & ' nstart_sup',nstart_sup,' nstart_seq',nstart_seq,
-cd & ' nsup',nsup
- do i=nstart_sup,nstart_sup+nsup-1
-cd write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)),
-cd & ' seq_pdb', restyp(itype_pdb(i))
- do j=i+2,nstart_sup+nsup-1
- nhpb=nhpb+1
- ihpb(nhpb)=i+nstart_seq-nstart_sup
- jhpb(nhpb)=j+nstart_seq-nstart_sup
- forcon(nhpb)=weidis
- dhpb(nhpb)=dist(i,j)
- enddo
- enddo
-cd write (iout,'(a)') 'Distance constraints:'
-cd do i=nss+1,nhpb
-cd ii=ihpb(i)
-cd jj=jhpb(i)
-cd iden='CA'
-cd if (ii.gt.nres) then
-cd iden='SC'
-cd ii=ii-nres
-cd jj=jj-nres
-cd endif
-cd write (iout,'(a,1x,a,i4,3x,a,1x,a,i4,2f10.3)')
-cd & restyp(itype(ii)),iden,ii,restyp(itype(jj)),iden,jj,
-cd & dhpb(i),forcon(i)
-cd enddo
- return
- end
-c----------------------------------------------------------------------------
- subroutine map_read
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MAP'
- include 'COMMON.IOUNITS'
- character*3 angid(4) /'THE','PHI','ALP','OME'/
- character*80 mapcard,ucase
- do imap=1,nmap
- read (inp,'(a)') mapcard
- mapcard=ucase(mapcard)
- if (index(mapcard,'PHI').gt.0) then
- kang(imap)=1
- else if (index(mapcard,'THE').gt.0) then
- kang(imap)=2
- else if (index(mapcard,'ALP').gt.0) then
- kang(imap)=3
- else if (index(mapcard,'OME').gt.0) then
- kang(imap)=4
- else
- write(iout,'(a)')'Error - illegal variable spec in MAP card.'
- stop 'Error - illegal variable spec in MAP card.'
- endif
- call readi (mapcard,'RES1',res1(imap),0)
- call readi (mapcard,'RES2',res2(imap),0)
- if (res1(imap).eq.0) then
- res1(imap)=res2(imap)
- else if (res2(imap).eq.0) then
- res2(imap)=res1(imap)
- endif
- if(res1(imap)*res2(imap).eq.0 .or. res1(imap).gt.res2(imap))then
- write (iout,'(a)')
- & 'Error - illegal definition of variable group in MAP.'
- stop 'Error - illegal definition of variable group in MAP.'
- endif
- call reada(mapcard,'FROM',ang_from(imap),0.0D0)
- call reada(mapcard,'TO',ang_to(imap),0.0D0)
- call readi(mapcard,'NSTEP',nstep(imap),0)
- if (ang_from(imap).eq.ang_to(imap) .or. nstep(imap).eq.0) then
- write (iout,'(a)')
- & 'Illegal boundary and/or step size specification in MAP.'
- stop 'Illegal boundary and/or step size specification in MAP.'
- endif
- enddo ! imap
- return
- end
-c----------------------------------------------------------------------------
-csa subroutine csaread
-csa implicit real*8 (a-h,o-z)
-csa include 'DIMENSIONS'
-csa include 'COMMON.IOUNITS'
-csa include 'COMMON.GEO'
-csa include 'COMMON.CSA'
-csa include 'COMMON.BANK'
-csa include 'COMMON.CONTROL'
-csa character*80 ucase
-csa character*620 mcmcard
-csa call card_concat(mcmcard)
-csa
-csa call readi(mcmcard,'NCONF',nconf,50)
-csa call readi(mcmcard,'NADD',nadd,0)
-csa call readi(mcmcard,'JSTART',jstart,1)
-csa call readi(mcmcard,'JEND',jend,1)
-csa call readi(mcmcard,'NSTMAX',nstmax,500000)
-csa call readi(mcmcard,'N0',n0,1)
-csa call readi(mcmcard,'N1',n1,6)
-csa call readi(mcmcard,'N2',n2,4)
-csa call readi(mcmcard,'N3',n3,0)
-csa call readi(mcmcard,'N4',n4,0)
-csa call readi(mcmcard,'N5',n5,0)
-csa call readi(mcmcard,'N6',n6,10)
-csa call readi(mcmcard,'N7',n7,0)
-csa call readi(mcmcard,'N8',n8,0)
-csa call readi(mcmcard,'N9',n9,0)
-csa call readi(mcmcard,'N14',n14,0)
-csa call readi(mcmcard,'N15',n15,0)
-csa call readi(mcmcard,'N16',n16,0)
-csa call readi(mcmcard,'N17',n17,0)
-csa call readi(mcmcard,'N18',n18,0)
-csa
-csa vdisulf=(index(mcmcard,'DYNSS').gt.0)
-csa
-csa call readi(mcmcard,'NDIFF',ndiff,2)
-csa call reada(mcmcard,'DIFFCUT',diffcut,0.0d0)
-csa call readi(mcmcard,'IS1',is1,1)
-csa call readi(mcmcard,'IS2',is2,8)
-csa call readi(mcmcard,'NRAN0',nran0,4)
-csa call readi(mcmcard,'NRAN1',nran1,2)
-csa call readi(mcmcard,'IRR',irr,1)
-csa call readi(mcmcard,'NSEED',nseed,20)
-csa call readi(mcmcard,'NTOTAL',ntotal,10000)
-csa call reada(mcmcard,'CUT1',cut1,2.0d0)
-csa call reada(mcmcard,'CUT2',cut2,5.0d0)
-csa call reada(mcmcard,'ESTOP',estop,-3000.0d0)
-csa call readi(mcmcard,'ICMAX',icmax,3)
-csa call readi(mcmcard,'IRESTART',irestart,0)
-csac!bankt call readi(mcmcard,'NBANKTM',ntbankm,0)
-csa ntbankm=0
-csac!bankt
-csa call reada(mcmcard,'DELE',dele,20.0d0)
-csa call reada(mcmcard,'DIFCUT',difcut,720.0d0)
-csa call readi(mcmcard,'IREF',iref,0)
-csa call reada(mcmcard,'RMSCUT',rmscut,4.0d0)
-csa call reada(mcmcard,'PNCCUT',pnccut,0.5d0)
-csa call readi(mcmcard,'NCONF_IN',nconf_in,0)
-csa call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0)
-csa write (iout,*) "NCONF_IN",nconf_in
-csa return
-csa end
-c----------------------------------------------------------------------------
-cfmc subroutine mcmfread
-cfmc implicit real*8 (a-h,o-z)
-cfmc include 'DIMENSIONS'
-cfmc include 'COMMON.MCMF'
-cfmc include 'COMMON.IOUNITS'
-cfmc include 'COMMON.GEO'
-cfmc character*80 ucase
-cfmc character*620 mcmcard
-cfmc call card_concat(mcmcard)
-cfmc
-cfmc call readi(mcmcard,'MAXRANT',maxrant,1000)
-cfmc write(iout,*)'MAXRANT=',maxrant
-cfmc call readi(mcmcard,'MAXFAM',maxfam,maxfam_p)
-cfmc write(iout,*)'MAXFAM=',maxfam
-cfmc call readi(mcmcard,'NNET1',nnet1,5)
-cfmc write(iout,*)'NNET1=',nnet1
-cfmc call readi(mcmcard,'NNET2',nnet2,4)
-cfmc write(iout,*)'NNET2=',nnet2
-cfmc call readi(mcmcard,'NNET3',nnet3,4)
-cfmc write(iout,*)'NNET3=',nnet3
-cfmc call readi(mcmcard,'ILASTT',ilastt,0)
-cfmc write(iout,*)'ILASTT=',ilastt
-cfmc call readi(mcmcard,'MAXSTR',maxstr,maxstr_mcmf)
-cfmc write(iout,*)'MAXSTR=',maxstr
-cfmc maxstr_f=maxstr/maxfam
-cfmc write(iout,*)'MAXSTR_F=',maxstr_f
-cfmc call readi(mcmcard,'NMCMF',nmcmf,10)
-cfmc write(iout,*)'NMCMF=',nmcmf
-cfmc call readi(mcmcard,'IFOCUS',ifocus,nmcmf)
-cfmc write(iout,*)'IFOCUS=',ifocus
-cfmc call readi(mcmcard,'NLOCMCMF',nlocmcmf,1000)
-cfmc write(iout,*)'NLOCMCMF=',nlocmcmf
-cfmc call readi(mcmcard,'INTPRT',intprt,1000)
-cfmc write(iout,*)'INTPRT=',intprt
-cfmc call readi(mcmcard,'IPRT',iprt,100)
-cfmc write(iout,*)'IPRT=',iprt
-cfmc call readi(mcmcard,'IMAXTR',imaxtr,100)
-cfmc write(iout,*)'IMAXTR=',imaxtr
-cfmc call readi(mcmcard,'MAXEVEN',maxeven,1000)
-cfmc write(iout,*)'MAXEVEN=',maxeven
-cfmc call readi(mcmcard,'MAXEVEN1',maxeven1,3)
-cfmc write(iout,*)'MAXEVEN1=',maxeven1
-cfmc call readi(mcmcard,'INIMIN',inimin,200)
-cfmc write(iout,*)'INIMIN=',inimin
-cfmc call readi(mcmcard,'NSTEPMCMF',nstepmcmf,10)
-cfmc write(iout,*)'NSTEPMCMF=',nstepmcmf
-cfmc call readi(mcmcard,'NTHREAD',nthread,5)
-cfmc write(iout,*)'NTHREAD=',nthread
-cfmc call readi(mcmcard,'MAXSTEPMCMF',maxstepmcmf,2500)
-cfmc write(iout,*)'MAXSTEPMCMF=',maxstepmcmf
-cfmc call readi(mcmcard,'MAXPERT',maxpert,9)
-cfmc write(iout,*)'MAXPERT=',maxpert
-cfmc call readi(mcmcard,'IRMSD',irmsd,1)
-cfmc write(iout,*)'IRMSD=',irmsd
-cfmc call reada(mcmcard,'DENEMIN',denemin,0.01D0)
-cfmc write(iout,*)'DENEMIN=',denemin
-cfmc call reada(mcmcard,'RCUT1S',rcut1s,3.5D0)
-cfmc write(iout,*)'RCUT1S=',rcut1s
-cfmc call reada(mcmcard,'RCUT1E',rcut1e,2.0D0)
-cfmc write(iout,*)'RCUT1E=',rcut1e
-cfmc call reada(mcmcard,'RCUT2S',rcut2s,0.5D0)
-cfmc write(iout,*)'RCUT2S=',rcut2s
-cfmc call reada(mcmcard,'RCUT2E',rcut2e,0.1D0)
-cfmc write(iout,*)'RCUT2E=',rcut2e
-cfmc call reada(mcmcard,'DPERT1',d_pert1,180.0D0)
-cfmc write(iout,*)'DPERT1=',d_pert1
-cfmc call reada(mcmcard,'DPERT1A',d_pert1a,180.0D0)
-cfmc write(iout,*)'DPERT1A=',d_pert1a
-cfmc call reada(mcmcard,'DPERT2',d_pert2,90.0D0)
-cfmc write(iout,*)'DPERT2=',d_pert2
-cfmc call reada(mcmcard,'DPERT2A',d_pert2a,45.0D0)
-cfmc write(iout,*)'DPERT2A=',d_pert2a
-cfmc call reada(mcmcard,'DPERT2B',d_pert2b,90.0D0)
-cfmc write(iout,*)'DPERT2B=',d_pert2b
-cfmc call reada(mcmcard,'DPERT2C',d_pert2c,60.0D0)
-cfmc write(iout,*)'DPERT2C=',d_pert2c
-cfmc d_pert1=deg2rad*d_pert1
-cfmc d_pert1a=deg2rad*d_pert1a
-cfmc d_pert2=deg2rad*d_pert2
-cfmc d_pert2a=deg2rad*d_pert2a
-cfmc d_pert2b=deg2rad*d_pert2b
-cfmc d_pert2c=deg2rad*d_pert2c
-cfmc call reada(mcmcard,'KT_MCMF1',kt_mcmf1,1.0D0)
-cfmc write(iout,*)'KT_MCMF1=',kt_mcmf1
-cfmc call reada(mcmcard,'KT_MCMF2',kt_mcmf2,1.0D0)
-cfmc write(iout,*)'KT_MCMF2=',kt_mcmf2
-cfmc call reada(mcmcard,'DKT_MCMF1',dkt_mcmf1,10.0D0)
-cfmc write(iout,*)'DKT_MCMF1=',dkt_mcmf1
-cfmc call reada(mcmcard,'DKT_MCMF2',dkt_mcmf2,1.0D0)
-cfmc write(iout,*)'DKT_MCMF2=',dkt_mcmf2
-cfmc call reada(mcmcard,'RCUTINI',rcutini,3.5D0)
-cfmc write(iout,*)'RCUTINI=',rcutini
-cfmc call reada(mcmcard,'GRAT',grat,0.5D0)
-cfmc write(iout,*)'GRAT=',grat
-cfmc call reada(mcmcard,'BIAS_MCMF',bias_mcmf,0.0D0)
-cfmc write(iout,*)'BIAS_MCMF=',bias_mcmf
-cfmc
-cfmc return
-cfmc end
-c----------------------------------------------------------------------------
- subroutine mcmread
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MCM'
- include 'COMMON.MCE'
- include 'COMMON.IOUNITS'
- character*80 ucase
- character*320 mcmcard
- call card_concat(mcmcard)
- call readi(mcmcard,'MAXACC',maxacc,100)
- call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000)
- call readi(mcmcard,'MAXTRIAL',maxtrial,100)
- call readi(mcmcard,'MAXTRIAL_ITER',maxtrial_iter,1000)
- call readi(mcmcard,'MAXREPM',maxrepm,200)
- call reada(mcmcard,'RANFRACT',RanFract,0.5D0)
- call reada(mcmcard,'POOL_FRACT',pool_fraction,0.01D0)
- call reada(mcmcard,'OVERLAP',overlap_cut,1.0D3)
- call reada(mcmcard,'E_UP',e_up,5.0D0)
- call reada(mcmcard,'DELTE',delte,0.1D0)
- call readi(mcmcard,'NSWEEP',nsweep,5)
- call readi(mcmcard,'NSTEPH',nsteph,0)
- call readi(mcmcard,'NSTEPC',nstepc,0)
- call reada(mcmcard,'TMIN',tmin,298.0D0)
- call reada(mcmcard,'TMAX',tmax,298.0D0)
- call readi(mcmcard,'NWINDOW',nwindow,0)
- call readi(mcmcard,'PRINT_MC',print_mc,0)
- print_stat=(index(mcmcard,'NO_PRINT_STAT').le.0)
- print_int=(index(mcmcard,'NO_PRINT_INT').le.0)
- ent_read=(index(mcmcard,'ENT_READ').gt.0)
- call readi(mcmcard,'SAVE_FREQ',save_frequency,1000)
- call readi(mcmcard,'MESSAGE_FREQ',message_frequency,1000)
- call readi(mcmcard,'POOL_READ_FREQ',pool_read_freq,5000)
- call readi(mcmcard,'POOL_SAVE_FREQ',pool_save_freq,1000)
- call readi(mcmcard,'PRINT_FREQ',print_freq,1000)
- if (nwindow.gt.0) then
- read (inp,*) (winstart(i),winend(i),i=1,nwindow)
- do i=1,nwindow
- winlen(i)=winend(i)-winstart(i)+1
- enddo
- endif
- if (tmax.lt.tmin) tmax=tmin
- if (tmax.eq.tmin) then
- nstepc=0
- nsteph=0
- endif
- if (nstepc.gt.0 .and. nsteph.gt.0) then
- tsteph=(tmax/tmin)**(1.0D0/(nsteph+0.0D0))
- tstepc=(tmax/tmin)**(1.0D0/(nstepc+0.0D0))
- endif
-C Probabilities of different move types
- sumpro_type(0)=0.0D0
- call reada(mcmcard,'MULTI_BOND',sumpro_type(1),1.0d0)
- call reada(mcmcard,'ONE_ANGLE' ,sumpro_type(2),2.0d0)
- sumpro_type(2)=sumpro_type(1)+sumpro_type(2)
- call reada(mcmcard,'THETA' ,sumpro_type(3),0.0d0)
- sumpro_type(3)=sumpro_type(2)+sumpro_type(3)
- call reada(mcmcard,'SIDE_CHAIN',sumpro_type(4),0.5d0)
- sumpro_type(4)=sumpro_type(3)+sumpro_type(4)
- do i=1,MaxMoveType
- print *,'i',i,' sumprotype',sumpro_type(i)
- sumpro_type(i)=sumpro_type(i)/sumpro_type(MaxMoveType)
- print *,'i',i,' sumprotype',sumpro_type(i)
- enddo
- return
- end
-c----------------------------------------------------------------------------
- subroutine read_minim
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.MINIM'
- include 'COMMON.IOUNITS'
- character*80 ucase
- character*320 minimcard
- call card_concat(minimcard)
- call readi(minimcard,'MAXMIN',maxmin,2000)
- call readi(minimcard,'MAXFUN',maxfun,5000)
- call readi(minimcard,'MINMIN',minmin,maxmin)
- call readi(minimcard,'MINFUN',minfun,maxmin)
- call reada(minimcard,'TOLF',tolf,1.0D-2)
- call reada(minimcard,'RTOLF',rtolf,1.0D-4)
- print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1)
- print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1)
- print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1)
- write (iout,'(/80(1h*)/20x,a/80(1h*))')
- & 'Options in energy minimization:'
- write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)')
- & 'MaxMin:',MaxMin,' MaxFun:',MaxFun,
- & 'MinMin:',MinMin,' MinFun:',MinFun,
- & ' TolF:',TolF,' RTolF:',RTolF
- return
- end
-c----------------------------------------------------------------------------
- subroutine read_angles(kanal,*)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
-c Read angles from input
-c
- read (kanal,*,err=10,end=10) (theta(i),i=3,nres)
- read (kanal,*,err=10,end=10) (phi(i),i=4,nres)
- read (kanal,*,err=10,end=10) (alph(i),i=2,nres-1)
- read (kanal,*,err=10,end=10) (omeg(i),i=2,nres-1)
-
- do i=1,nres
-c 9/7/01 avoid 180 deg valence angle
- if (theta(i).gt.179.99d0) theta(i)=179.99d0
-c
- theta(i)=deg2rad*theta(i)
- phi(i)=deg2rad*phi(i)
- alph(i)=deg2rad*alph(i)
- omeg(i)=deg2rad*omeg(i)
- enddo
- return
- 10 return1
- end
-c----------------------------------------------------------------------------
- subroutine reada(rekord,lancuch,wartosc,default)
- implicit none
- character*(*) rekord,lancuch
- double precision wartosc,default
- integer ilen,iread
- external ilen
- iread=index(rekord,lancuch)
- if (iread.eq.0) then
- wartosc=default
- return
- endif
- iread=iread+ilen(lancuch)+1
- read (rekord(iread:),*,err=10,end=10) wartosc
- return
- 10 wartosc=default
- return
- end
-c----------------------------------------------------------------------------
- subroutine readi(rekord,lancuch,wartosc,default)
- implicit none
- character*(*) rekord,lancuch
- integer wartosc,default
- integer ilen,iread
- external ilen
- iread=index(rekord,lancuch)
- if (iread.eq.0) then
- wartosc=default
- return
- endif
- iread=iread+ilen(lancuch)+1
- read (rekord(iread:),*,err=10,end=10) wartosc
- return
- 10 wartosc=default
- return
- end
-c----------------------------------------------------------------------------
- subroutine multreadi(rekord,lancuch,tablica,dim,default)
- implicit none
- integer dim,i
- integer tablica(dim),default
- character*(*) rekord,lancuch
- character*80 aux
- integer ilen,iread
- external ilen
- do i=1,dim
- tablica(i)=default
- enddo
- iread=index(rekord,lancuch(:ilen(lancuch))//"=")
- if (iread.eq.0) return
- iread=iread+ilen(lancuch)+1
- read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
- 10 return
- end
-c----------------------------------------------------------------------------
- subroutine multreada(rekord,lancuch,tablica,dim,default)
- implicit none
- integer dim,i
- double precision tablica(dim),default
- character*(*) rekord,lancuch
- character*80 aux
- integer ilen,iread
- external ilen
- do i=1,dim
- tablica(i)=default
- enddo
- iread=index(rekord,lancuch(:ilen(lancuch))//"=")
- if (iread.eq.0) return
- iread=iread+ilen(lancuch)+1
- read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
- 10 return
- end
-c----------------------------------------------------------------------------
- subroutine openunits
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- character*16 form,nodename
- integer nodelen
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.IOUNITS'
- include 'COMMON.MD'
- include 'COMMON.CONTROL'
- integer lenpre,lenpot,ilen,lentmp
- external ilen
- character*3 out1file_text,ucase
- character*3 ll
- external ucase
-c print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits"
- call getenv_loc("PREFIX",prefix)
- pref_orig = prefix
- call getenv_loc("POT",pot)
- call getenv_loc("DIRTMP",tmpdir)
- call getenv_loc("CURDIR",curdir)
- call getenv_loc("OUT1FILE",out1file_text)
-c print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV"
- out1file_text=ucase(out1file_text)
- if (out1file_text(1:1).eq."Y") then
- out1file=.true.
- else
- out1file=fg_rank.gt.0
- endif
- lenpre=ilen(prefix)
- lenpot=ilen(pot)
- lentmp=ilen(tmpdir)
- if (lentmp.gt.0) then
- write (*,'(80(1h!))')
- write (*,'(a,19x,a,19x,a)') "!"," A T T E N T I O N ","!"
- write (*,'(80(1h!))')
- write (*,*)"All output files will be on node /tmp directory."
-#ifdef MPI
- call MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR )
- if (me.eq.king) then
- write (*,*) "The master node is ",nodename
- else if (fg_rank.eq.0) then
- write (*,*) "I am the CG slave node ",nodename
- else
- write (*,*) "I am the FG slave node ",nodename
- endif
-#endif
- PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre)
- lenpre = lentmp+lenpre+1
- endif
- entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr'
-C Get the names and open the input files
-#if defined(WINIFL) || defined(WINPGI)
- open(1,file=pref_orig(:ilen(pref_orig))//
- & '.inp',status='old',readonly,shared)
- open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
-C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
-C Get parameter filenames and open the parameter files.
- call getenv_loc('BONDPAR',bondname)
- open (ibond,file=bondname,status='old',readonly,shared)
- call getenv_loc('THETPAR',thetname)
- open (ithep,file=thetname,status='old',readonly,shared)
-#ifndef CRYST_THETA
- call getenv_loc('THETPARPDB',thetname_pdb)
- open (ithep_pdb,file=thetname_pdb,status='old',readonly,shared)
-#endif
- call getenv_loc('ROTPAR',rotname)
- open (irotam,file=rotname,status='old',readonly,shared)
-#ifndef CRYST_SC
- call getenv_loc('ROTPARPDB',rotname_pdb)
- open (irotam_pdb,file=rotname_pdb,status='old',readonly,shared)
-#endif
- call getenv_loc('TORPAR',torname)
- open (itorp,file=torname,status='old',readonly,shared)
- call getenv_loc('TORDPAR',tordname)
- open (itordp,file=tordname,status='old',readonly,shared)
- call getenv_loc('FOURIER',fouriername)
- open (ifourier,file=fouriername,status='old',readonly,shared)
- call getenv_loc('ELEPAR',elename)
- open (ielep,file=elename,status='old',readonly,shared)
- call getenv_loc('SIDEPAR',sidename)
- open (isidep,file=sidename,status='old',readonly,shared)
-#elif (defined CRAY) || (defined AIX)
- open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',
- & action='read')
-c print *,"Processor",myrank," opened file 1"
- open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
-c print *,"Processor",myrank," opened file 9"
-C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
-C Get parameter filenames and open the parameter files.
- call getenv_loc('BONDPAR',bondname)
- open (ibond,file=bondname,status='old',action='read')
-c print *,"Processor",myrank," opened file IBOND"
- call getenv_loc('THETPAR',thetname)
- open (ithep,file=thetname,status='old',action='read')
-c print *,"Processor",myrank," opened file ITHEP"
-#ifndef CRYST_THETA
- call getenv_loc('THETPARPDB',thetname_pdb)
- open (ithep_pdb,file=thetname_pdb,status='old',action='read')
-#endif
- call getenv_loc('ROTPAR',rotname)
- open (irotam,file=rotname,status='old',action='read')
-c print *,"Processor",myrank," opened file IROTAM"
-#ifndef CRYST_SC
- call getenv_loc('ROTPARPDB',rotname_pdb)
- open (irotam_pdb,file=rotname_pdb,status='old',action='read')
-#endif
- call getenv_loc('TORPAR',torname)
- open (itorp,file=torname,status='old',action='read')
-c print *,"Processor",myrank," opened file ITORP"
- call getenv_loc('TORDPAR',tordname)
- open (itordp,file=tordname,status='old',action='read')
-c print *,"Processor",myrank," opened file ITORDP"
- call getenv_loc('SCCORPAR',sccorname)
- open (isccor,file=sccorname,status='old',action='read')
-c print *,"Processor",myrank," opened file ISCCOR"
- call getenv_loc('FOURIER',fouriername)
- open (ifourier,file=fouriername,status='old',action='read')
-c print *,"Processor",myrank," opened file IFOURIER"
- call getenv_loc('ELEPAR',elename)
- open (ielep,file=elename,status='old',action='read')
-c print *,"Processor",myrank," opened file IELEP"
- call getenv_loc('SIDEPAR',sidename)
- open (isidep,file=sidename,status='old',action='read')
-c print *,"Processor",myrank," opened file ISIDEP"
-c print *,"Processor",myrank," opened parameter files"
-#elif (defined G77)
- open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old')
- open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
-C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
-C Get parameter filenames and open the parameter files.
- call getenv_loc('BONDPAR',bondname)
- open (ibond,file=bondname,status='old')
- call getenv_loc('THETPAR',thetname)
- open (ithep,file=thetname,status='old')
-#ifndef CRYST_THETA
- call getenv_loc('THETPARPDB',thetname_pdb)
- open (ithep_pdb,file=thetname_pdb,status='old')
-#endif
- call getenv_loc('ROTPAR',rotname)
- open (irotam,file=rotname,status='old')
-#ifndef CRYST_SC
- call getenv_loc('ROTPARPDB',rotname_pdb)
- open (irotam_pdb,file=rotname_pdb,status='old')
-#endif
- call getenv_loc('TORPAR',torname)
- open (itorp,file=torname,status='old')
- call getenv_loc('TORDPAR',tordname)
- open (itordp,file=tordname,status='old')
- call getenv_loc('SCCORPAR',sccorname)
- open (isccor,file=sccorname,status='old')
- call getenv_loc('FOURIER',fouriername)
- open (ifourier,file=fouriername,status='old')
- call getenv_loc('ELEPAR',elename)
- open (ielep,file=elename,status='old')
- call getenv_loc('SIDEPAR',sidename)
- open (isidep,file=sidename,status='old')
-#else
- open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old',
- &action='read')
- open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown')
-C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown')
-C Get parameter filenames and open the parameter files.
- call getenv_loc('BONDPAR',bondname)
- open (ibond,file=bondname,status='old',action='read')
- call getenv_loc('THETPAR',thetname)
- open (ithep,file=thetname,status='old',action='read')
-#ifndef CRYST_THETA
- call getenv_loc('THETPARPDB',thetname_pdb)
- print *,"thetname_pdb ",thetname_pdb
- open (ithep_pdb,file=thetname_pdb,status='old',action='read')
- print *,ithep_pdb," opened"
-#endif
- call getenv_loc('ROTPAR',rotname)
- open (irotam,file=rotname,status='old',action='read')
-#ifndef CRYST_SC
- call getenv_loc('ROTPARPDB',rotname_pdb)
- open (irotam_pdb,file=rotname_pdb,status='old',action='read')
-#endif
- call getenv_loc('TORPAR',torname)
- open (itorp,file=torname,status='old',action='read')
- call getenv_loc('TORDPAR',tordname)
- open (itordp,file=tordname,status='old',action='read')
- call getenv_loc('SCCORPAR',sccorname)
- open (isccor,file=sccorname,status='old',action='read')
- call getenv_loc('FOURIER',fouriername)
- open (ifourier,file=fouriername,status='old',action='read')
- call getenv_loc('ELEPAR',elename)
- open (ielep,file=elename,status='old',action='read')
- call getenv_loc('SIDEPAR',sidename)
- open (isidep,file=sidename,status='old',action='read')
-#endif
-#ifndef OLDSCP
-C
-C 8/9/01 In the newest version SCp interaction constants are read from a file
-C Use -DOLDSCP to use hard-coded constants instead.
-C
- call getenv_loc('SCPPAR',scpname)
-#if defined(WINIFL) || defined(WINPGI)
- open (iscpp,file=scpname,status='old',readonly,shared)
-#elif (defined CRAY) || (defined AIX)
- open (iscpp,file=scpname,status='old',action='read')
-#elif (defined G77)
- open (iscpp,file=scpname,status='old')
-#else
- open (iscpp,file=scpname,status='old',action='read')
-#endif
-#endif
- call getenv_loc('PATTERN',patname)
-#if defined(WINIFL) || defined(WINPGI)
- open (icbase,file=patname,status='old',readonly,shared)
-#elif (defined CRAY) || (defined AIX)
- open (icbase,file=patname,status='old',action='read')
-#elif (defined G77)
- open (icbase,file=patname,status='old')
-#else
- open (icbase,file=patname,status='old',action='read')
-#endif
-#ifdef MPI
-C Open output file only for CG processes
-c print *,"Processor",myrank," fg_rank",fg_rank
- if (fg_rank.eq.0) then
-
- if (nodes.eq.1) then
- npos=3
- else
- npos = dlog10(dfloat(nodes-1))+1
- endif
- if (npos.lt.3) npos=3
- write (liczba,'(i1)') npos
- form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba))
- & //')'
- write (liczba,form) me
- outname=prefix(:lenpre)//'.out_'//pot(:lenpot)//
- & liczba(:ilen(liczba))
- intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba))
- & //'.int'
- pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba))
- & //'.pdb'
- mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//
- & liczba(:ilen(liczba))//'.mol2'
- statname=prefix(:lenpre)//'_'//pot(:lenpot)//
- & liczba(:ilen(liczba))//'.stat'
- if (lentmp.gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot)
- & //liczba(:ilen(liczba))//'.stat')
- rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba))
- & //'.rst'
- if(usampl) then
- qname=prefix(:lenpre)//'_'//pot(:lenpot)//
- & liczba(:ilen(liczba))//'.const'
- endif
-
- endif
-#else
- outname=prefix(:lenpre)//'.out_'//pot(:lenpot)
- intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int'
- pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb'
- mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2'
- statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat'
- if (lentmp.gt.0)
- & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot)
- & //'.stat')
- rest2name=prefix(:ilen(prefix))//'.rst'
- if(usampl) then
- qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const'
- endif
-#endif
-#if defined(AIX) || defined(PGI)
- if (me.eq.king .or. .not. out1file)
- & open(iout,file=outname,status='unknown')
-c#define DEBUG
-#ifdef DEBUG
- if (fg_rank.gt.0) then
- write (liczba,'(i3.3)') myrank/nfgtasks
- write (ll,'(bz,i3.3)') fg_rank
- open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,
- & status='unknown')
- endif
-#endif
-c#undef DEBUG
- if(me.eq.king) then
- open(igeom,file=intname,status='unknown',position='append')
- open(ipdb,file=pdbname,status='unknown')
- open(imol2,file=mol2name,status='unknown')
- open(istat,file=statname,status='unknown',position='append')
- else
-c1out open(iout,file=outname,status='unknown')
- endif
-#else
- if (me.eq.king .or. .not.out1file)
- & open(iout,file=outname,status='unknown')
-c#define DEBUG
-#ifdef DEBUG
- if (fg_rank.gt.0) then
- print "Processor",fg_rank," opening output file"
- write (liczba,'(i3.3)') myrank/nfgtasks
- write (ll,'(bz,i3.3)') fg_rank
- open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll,
- & status='unknown')
- endif
-#endif
-c#undef DEBUG
- if(me.eq.king) then
- open(igeom,file=intname,status='unknown',access='append')
- open(ipdb,file=pdbname,status='unknown')
- open(imol2,file=mol2name,status='unknown')
- open(istat,file=statname,status='unknown',access='append')
- else
-c1out open(iout,file=outname,status='unknown')
- endif
-#endif
-csa csa_rbank=prefix(:lenpre)//'.CSA.rbank'
-csa csa_seed=prefix(:lenpre)//'.CSA.seed'
-csa csa_history=prefix(:lenpre)//'.CSA.history'
-csa csa_bank=prefix(:lenpre)//'.CSA.bank'
-csa csa_bank1=prefix(:lenpre)//'.CSA.bank1'
-csa csa_alpha=prefix(:lenpre)//'.CSA.alpha'
-csa csa_alpha1=prefix(:lenpre)//'.CSA.alpha1'
-csac!bankt csa_bankt=prefix(:lenpre)//'.CSA.bankt'
-csa csa_int=prefix(:lenpre)//'.int'
-csa csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized'
-csa csa_native_int=prefix(:lenpre)//'.CSA.native.int'
-csa csa_in=prefix(:lenpre)//'.CSA.in'
-c print *,"Processor",myrank,"fg_rank",fg_rank," opened files"
-C Write file names
- if (me.eq.king)then
- write (iout,'(80(1h-))')
- write (iout,'(30x,a)') "FILE ASSIGNMENT"
- write (iout,'(80(1h-))')
- write (iout,*) "Input file : ",
- & pref_orig(:ilen(pref_orig))//'.inp'
- write (iout,*) "Output file : ",
- & outname(:ilen(outname))
- write (iout,*)
- write (iout,*) "Sidechain potential file : ",
- & sidename(:ilen(sidename))
-#ifndef OLDSCP
- write (iout,*) "SCp potential file : ",
- & scpname(:ilen(scpname))
-#endif
- write (iout,*) "Electrostatic potential file : ",
- & elename(:ilen(elename))
- write (iout,*) "Cumulant coefficient file : ",
- & fouriername(:ilen(fouriername))
- write (iout,*) "Torsional parameter file : ",
- & torname(:ilen(torname))
- write (iout,*) "Double torsional parameter file : ",
- & tordname(:ilen(tordname))
- write (iout,*) "SCCOR parameter file : ",
- & sccorname(:ilen(sccorname))
- write (iout,*) "Bond & inertia constant file : ",
- & bondname(:ilen(bondname))
- write (iout,*) "Bending parameter file : ",
- & thetname(:ilen(thetname))
- write (iout,*) "Rotamer parameter file : ",
- & rotname(:ilen(rotname))
- write (iout,*) "Threading database : ",
- & patname(:ilen(patname))
- if (lentmp.ne.0)
- &write (iout,*)" DIRTMP : ",
- & tmpdir(:lentmp)
- write (iout,'(80(1h-))')
- endif
- return
- end
-c----------------------------------------------------------------------------
- subroutine card_concat(card)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- character*(*) card
- character*80 karta,ucase
- external ilen
- read (inp,'(a)') karta
- karta=ucase(karta)
- card=' '
- do while (karta(80:80).eq.'&')
- card=card(:ilen(card)+1)//karta(:79)
- read (inp,'(a)') karta
- karta=ucase(karta)
- enddo
- card=card(:ilen(card)+1)//karta
- return
- end
-c----------------------------------------------------------------------------------
- subroutine readrst
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.MD'
- open(irest2,file=rest2name,status='unknown')
- read(irest2,*) totT,EK,potE,totE,t_bath
- do i=1,2*nres
- read(irest2,'(3e15.5)') (d_t(j,i),j=1,3)
- enddo
- do i=1,2*nres
- read(irest2,'(3e15.5)') (dc(j,i),j=1,3)
- enddo
- if(usampl) then
- read (irest2,*) iset
- endif
- close(irest2)
- return
- end
-c---------------------------------------------------------------------------------
- subroutine read_fragments
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.MD'
- include 'COMMON.CONTROL'
- read(inp,*) nset,nfrag,npair,nfrag_back
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "nset",nset," nfrag",nfrag," npair",npair,
- & " nfrag_back",nfrag_back
- do iset=1,nset
- read(inp,*) mset(iset)
- do i=1,nfrag
- read(inp,*) wfrag(i,iset),ifrag(1,i,iset),ifrag(2,i,iset),
- & qinfrag(i,iset)
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "R ",i,wfrag(i,iset),ifrag(1,i,iset),
- & ifrag(2,i,iset), qinfrag(i,iset)
- enddo
- do i=1,npair
- read(inp,*) wpair(i,iset),ipair(1,i,iset),ipair(2,i,iset),
- & qinpair(i,iset)
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "R ",i,wpair(i,iset),ipair(1,i,iset),
- & ipair(2,i,iset), qinpair(i,iset)
- enddo
- do i=1,nfrag_back
- read(inp,*) wfrag_back(1,i,iset),wfrag_back(2,i,iset),
- & wfrag_back(3,i,iset),
- & ifrag_back(1,i,iset),ifrag_back(2,i,iset)
- if(me.eq.king.or..not.out1file)
- & write(iout,*) "A",i,wfrag_back(1,i,iset),wfrag_back(2,i,iset),
- & wfrag_back(3,i,iset),ifrag_back(1,i,iset),ifrag_back(2,i,iset)
- enddo
- enddo
- return
- end
-c-------------------------------------------------------------------------------
- subroutine read_dist_constr
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.SBRIDGE'
- integer ifrag_(2,100),ipair_(2,100)
- double precision wfrag_(100),wpair_(100)
- character*500 controlcard
-c write (iout,*) "Calling read_dist_constr"
-c write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup
-c call flush(iout)
- call card_concat(controlcard)
- call readi(controlcard,"NFRAG",nfrag_,0)
- call readi(controlcard,"NPAIR",npair_,0)
- call readi(controlcard,"NDIST",ndist_,0)
- call reada(controlcard,'DIST_CUT',dist_cut,5.0d0)
- call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0)
- call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0)
- call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0)
- call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0)
-c write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_
-c write (iout,*) "IFRAG"
-c do i=1,nfrag_
-c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
-c enddo
-c write (iout,*) "IPAIR"
-c do i=1,npair_
-c write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i)
-c enddo
- if (.not.refstr .and. nfrag.gt.0) then
- write (iout,*)
- & "ERROR: no reference structure to compute distance restraints"
- write (iout,*)
- & "Restraints must be specified explicitly (NDIST=number)"
- stop
- endif
- if (nfrag.lt.2 .and. npair.gt.0) then
- write (iout,*) "ERROR: Less than 2 fragments specified",
- & " but distance restraints between pairs requested"
- stop
- endif
- call flush(iout)
- do i=1,nfrag_
- if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup
- if (ifrag_(2,i).gt.nstart_sup+nsup-1)
- & ifrag_(2,i)=nstart_sup+nsup-1
-c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i)
- call flush(iout)
- if (wfrag_(i).gt.0.0d0) then
- do j=ifrag_(1,i),ifrag_(2,i)-1
- do k=j+1,ifrag_(2,i)
-c write (iout,*) "j",j," k",k
- ddjk=dist(j,k)
- if (constr_dist.eq.1) then
- nhpb=nhpb+1
- ihpb(nhpb)=j
- jhpb(nhpb)=k
- dhpb(nhpb)=ddjk
- forcon(nhpb)=wfrag_(i)
- else if (constr_dist.eq.2) then
- if (ddjk.le.dist_cut) then
- nhpb=nhpb+1
- ihpb(nhpb)=j
- jhpb(nhpb)=k
- dhpb(nhpb)=ddjk
- forcon(nhpb)=wfrag_(i)
- endif
- else
- nhpb=nhpb+1
- ihpb(nhpb)=j
- jhpb(nhpb)=k
- dhpb(nhpb)=ddjk
- forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2)
- endif
-#ifdef MPI
- if (.not.out1file .or. me.eq.king)
- & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#else
- write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#endif
- enddo
- enddo
- endif
- enddo
- do i=1,npair_
- if (wpair_(i).gt.0.0d0) then
- ii = ipair_(1,i)
- jj = ipair_(2,i)
- if (ii.gt.jj) then
- itemp=ii
- ii=jj
- jj=itemp
- endif
- do j=ifrag_(1,ii),ifrag_(2,ii)
- do k=ifrag_(1,jj),ifrag_(2,jj)
- nhpb=nhpb+1
- ihpb(nhpb)=j
- jhpb(nhpb)=k
- forcon(nhpb)=wpair_(i)
- dhpb(nhpb)=dist(j,k)
-#ifdef MPI
- if (.not.out1file .or. me.eq.king)
- & write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#else
- write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ",
- & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb)
-#endif
- enddo
- enddo
- endif
- enddo
- do i=1,ndist_
- read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i),
- & ibecarb(i),forcon(nhpb+1)
- if (forcon(nhpb+1).gt.0.0d0) then
- nhpb=nhpb+1
- if (ibecarb(i).gt.0) then
- ihpb(i)=ihpb(i)+nres
- jhpb(i)=jhpb(i)+nres
- endif
- if (dhpb(nhpb).eq.0.0d0)
- & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb))
- endif
- enddo
-#ifdef MPI
- if (.not.out1file .or. me.eq.king) then
-#endif
- do i=1,nhpb
- write (iout,'(a,3i5,2f8.2,i2,f10.1)') "+dist.constr ",
- & i,ihpb(i),jhpb(i),dhpb(i),dhpb1(i),ibecarb(i),forcon(i)
- enddo
- call flush(iout)
-#ifdef MPI
- endif
-#endif
- return
- end
-c-------------------------------------------------------------------------------
-
- subroutine read_constr_homology
-
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.MD'
-
- character*2 kic2
- character*24 model_ki_dist, model_ki_angle
- character*500 controlcard
- integer ki, i, j, k, l
-
-
- call card_concat(controlcard)
- call reada(controlcard,"HOMOL_DIST",waga_dist,1.0)
- call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0)
-
- do ki=1,constr_homology
- if (constr_homology.ge.1) then
-
- write(kic2,'(i2)') ki
-c write(iout,*) "TEST KICA, HOMOL", kic2
- if (ki.le.9) kic2="0"//kic2(2:2)
-c write(iout,*) "TEST KICA2, HOMOL", kic2
-
- model_ki_dist="model"//kic2//".dist"
- model_ki_angle="model"//kic2//".angle"
-c write(iout,*) model_ki_dist, model_ki_angle
- open (1400+ki,file=model_ki_dist,status='old')
- open (1401+ki,file=model_ki_angle,status='old')
-
- do irec=1,99999 !petla do czytania wiezow na odleglosc
- read (1400+ki,*,end=1401) i, j, odl(i,j,ki),sigma_odl(i,j,ki)
- lim_odl=i
- enddo
- 1401 continue
- do irec=1,99999 !petla do czytania wiezow na katach torsyjnych
- read (1401+ki,*,end=1402) i, j, k,l,dih(i,ki),sigma_dih(i,ki)
- lim_dih=i
-c dih(i,ki)=dih(i,ki)
- enddo
- 1402 continue
- endif
- enddo
-
-c write(iout,*) "TEST CZYTANIA1",odl(1,2,1),odl(1,3,1),odl(1,4,1)
-c write(iout,*) "TEST CZYTANIA2",dih(1,1),dih(2,1),dih(3,1)
-
-
- return
- end
-c----------------------------------------------------------------------
-
-#ifdef WINIFL
- subroutine flush(iu)
- return
- end
-#endif
-#ifdef AIX
- subroutine flush(iu)
- call flush_(iu)
- return
- end
-#endif
-c------------------------------------------------------------------------------
- subroutine copy_to_tmp(source)
- include "DIMENSIONS"
- include "COMMON.IOUNITS"
- character*(*) source
- character* 256 tmpfile
- integer ilen
- external ilen
- logical ex
- tmpfile=curdir(:ilen(curdir))//"/"//source(:ilen(source))
- inquire(file=tmpfile,exist=ex)
- if (ex) then
- write (*,*) "Copying ",tmpfile(:ilen(tmpfile)),
- & " to temporary directory..."
- write (*,*) "/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir
- call system("/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir)
- endif
- return
- end
-c------------------------------------------------------------------------------
- subroutine move_from_tmp(source)
- include "DIMENSIONS"
- include "COMMON.IOUNITS"
- character*(*) source
- integer ilen
- external ilen
- write (*,*) "Moving ",source(:ilen(source)),
- & " from temporary directory to working directory"
- write (*,*) "/bin/mv "//source(:ilen(source))//" "//curdir
- call system("/bin/mv "//source(:ilen(source))//" "//curdir)
- return
- end
-c------------------------------------------------------------------------------
- subroutine random_init(seed)
-C
-C Initialize random number generator
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef AMD64
- integer*8 iseedi8
-#endif
-#ifdef MPI
- include 'mpif.h'
- logical OKRandom, prng_restart
- real*8 r1
- integer iseed_array(4)
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.THREAD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.MCM'
- include 'COMMON.MAP'
- include 'COMMON.HEADER'
-csa include 'COMMON.CSA'
- include 'COMMON.CHAIN'
- include 'COMMON.MUCA'
- include 'COMMON.MD'
- include 'COMMON.FFIELD'
- include 'COMMON.SETUP'
- iseed=-dint(dabs(seed))
- if (iseed.eq.0) then
- write (iout,'(/80(1h*)/20x,a/80(1h*))')
- & 'Random seed undefined. The program will stop.'
- write (*,'(/80(1h*)/20x,a/80(1h*))')
- & 'Random seed undefined. The program will stop.'
-#ifdef MPI
- call mpi_finalize(mpi_comm_world,ierr)
-#endif
- stop 'Bad random seed.'
- endif
-#ifdef MPI
- if (fg_rank.eq.0) then
- seed=seed*(me+1)+1
-#ifdef AMD64
- iseedi8=dint(seed)
- if(me.eq.king .or. .not. out1file)
- & write (iout,*) 'MPI: node= ', me, ' iseed= ',iseedi8
- write (*,*) 'MPI: node= ', me, ' iseed= ',iseedi8
- OKRandom = prng_restart(me,iseedi8)
-#else
- do i=1,4
- tmp=65536.0d0**(4-i)
- iseed_array(i) = dint(seed/tmp)
- seed=seed-iseed_array(i)*tmp
- enddo
- if(me.eq.king .or. .not. out1file)
- & write (iout,*) 'MPI: node= ', me, ' iseed(4)= ',
- & (iseed_array(i),i=1,4)
- write (*,*) 'MPI: node= ',me, ' iseed(4)= ',
- & (iseed_array(i),i=1,4)
- OKRandom = prng_restart(me,iseed_array)
-#endif
- if (OKRandom) then
- r1=ran_number(0.0D0,1.0D0)
- if(me.eq.king .or. .not. out1file)
- & write (iout,*) 'ran_num',r1
- if (r1.lt.0.0d0) OKRandom=.false.
- endif
- if (.not.OKRandom) then
- write (iout,*) 'PRNG IS NOT WORKING!!!'
- print *,'PRNG IS NOT WORKING!!!'
- if (me.eq.0) then
- call flush(iout)
- call mpi_abort(mpi_comm_world,error_msg,ierr)
- stop
- else
- write (iout,*) 'too many processors for parallel prng'
- write (*,*) 'too many processors for parallel prng'
- call flush(iout)
- stop
- endif
- endif
- endif
-#else
- call vrndst(iseed)
- write (iout,*) 'ran_num',ran_number(0.0d0,1.0d0)
-#endif
- return
- end
+++ /dev/null
- subroutine refsys(i2,i3,i4,e1,e2,e3,fail)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-c this subroutine calculates unity vectors of a local reference system
-c defined by atoms (i2), (i3), and (i4). the x axis is the axis from
-c atom (i3) to atom (i2), and the xy plane is the plane defined by atoms
-c (i2), (i3), and (i4). z axis is directed according to the sign of the
-c vector product (i3)-(i2) and (i3)-(i4). sets fail to .true. if atoms
-c (i2) and (i3) or (i3) and (i4) coincide or atoms (i2), (i3), and (i4)
-c form a linear fragment. returns vectors e1, e2, and e3.
- logical fail
- double precision e1(3),e2(3),e3(3)
- double precision u(3),z(3)
- include 'COMMON.IOUNITS'
- include "COMMON.CHAIN"
- data coinc /1.0d-13/,align /1.0d-13/
- fail=.false.
- s1=0.0d0
- s2=0.0d0
- do 1 i=1,3
- zi=c(i,i2)-c(i,i3)
- ui=c(i,i4)-c(i,i3)
- s1=s1+zi*zi
- s2=s2+ui*ui
- z(i)=zi
- 1 u(i)=ui
- s1=sqrt(s1)
- s2=sqrt(s2)
- if (s1.gt.coinc) goto 2
- write (iout,1000) i2,i3,i1
- fail=.true.
- return
- 2 if (s2.gt.coinc) goto 4
- write(iout,1000) i3,i4,i1
- fail=.true.
- return
- 4 s1=1.0/s1
- s2=1.0/s2
- v1=z(2)*u(3)-z(3)*u(2)
- v2=z(3)*u(1)-z(1)*u(3)
- v3=z(1)*u(2)-z(2)*u(1)
- anorm=sqrt(v1*v1+v2*v2+v3*v3)
- if (anorm.gt.align) goto 6
- write (iout,1010) i2,i3,i4,i1
- fail=.true.
- return
- 6 anorm=1.0/anorm
- e3(1)=v1*anorm
- e3(2)=v2*anorm
- e3(3)=v3*anorm
- e1(1)=z(1)*s1
- e1(2)=z(2)*s1
- e1(3)=z(3)*s1
- e2(1)=e1(3)*e3(2)-e1(2)*e3(3)
- e2(2)=e1(1)*e3(3)-e1(3)*e3(1)
- e2(3)=e1(2)*e3(1)-e1(1)*e3(2)
- 1000 format (/1x,' * * * error - atoms',i4,' and',i4,' coincide.')
- 1010 format (/1x,' * * * error - atoms',2(i4,2h, ),i4,' form a linear')
- return
- end
+++ /dev/null
- subroutine regularize(ncart,etot,rms,cref0,iretcode)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.HEADER'
- include 'COMMON.IOUNITS'
- include 'COMMON.MINIM'
- double precision przes(3),obrot(3,3),fhpb0(maxdim),varia(maxvar)
- double precision cref0(3,ncart)
- double precision energia(0:n_ene)
- logical non_conv
- link_end0=link_end
- do i=1,nhpb
- fhpb0(i)=forcon(i)
- enddo
- maxit_reg=2
- print *,'Enter REGULARIZE: nnt=',nnt,' nct=',nct,' nsup=',nsup,
- & ' nstart_seq=',nstart_seq,' nstart_sup',nstart_sup
- write (iout,'(/a/)') 'Initial energies:'
- call geom_to_var(nvar,varia)
- call chainbuild
- call etotal(energia(0))
- etot=energia(0)
- call enerprint(energia(0))
- call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1),
- & nsup,przes,obrot,non_conv)
- write (iout,'(a,f10.5)')
- & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms))
- write (*,'(a,f10.5)')
- & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms))
- maxit0=maxit
- maxfun0=maxfun
- rtolf0=rtolf
- maxit=100
- maxfun=200
- rtolf=1.0D-2
- do it=1,maxit_reg
- print *,'Regularization: pass:',it
-C Minimize with distance constraints, gradually relieving the weight.
- call minimize(etot,varia,iretcode,nfun)
- print *,'Etot=',Etot
- if (iretcode.eq.11) return
- call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1),
- & nsup,przes,obrot,non_conv)
- rms=dsqrt(rms)
- write (iout,'(a,i2,a,f10.5,a,1pe14.5,a,i3/)')
- & 'Finish pass',it,', RMS deviation:',rms,', energy',etot,
- & ' SUMSL convergence',iretcode
- do i=nss+1,nhpb
- forcon(i)=0.1D0*forcon(i)
- enddo
- enddo
-C Turn off the distance constraints and re-minimize energy.
- print *,'Final minimization ... '
- maxit=maxit0
- maxfun=maxfun0
- rtolf=rtolf0
- link_end=min0(link_end,nss)
- call minimize(etot,varia,iretcode,nfun)
- print *,'Etot=',Etot
- call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1),nsup,
- & przes,obrot,non_conv)
- rms=dsqrt(rms)
- write (iout,'(a,f10.5,a,1pe14.5,a,i3/)')
- & 'Final RMS deviation:',rms,' energy',etot,' SUMSL convergence',
- & iretcode
- link_end=link_end0
- do i=nss+1,nhpb
- forcon(i)=fhpb0(i)
- enddo
- call var_to_geom(nvar,varia)
- call chainbuild
- return
- end
+++ /dev/null
- integer function rescode(iseq,nam,itype)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- character*3 nam,ucase
-
- if (itype.eq.0) then
-
- do i=1,ntyp1
- if (ucase(nam).eq.restyp(i)) then
- rescode=i
- return
- endif
- enddo
-
- else
-
- do i=1,ntyp1
- if (nam(1:1).eq.onelet(i)) then
- rescode=i
- return
- endif
- enddo
-
- endif
-
- write (iout,10) iseq,nam
- stop
- 10 format ('**** Error - residue',i4,' has an unresolved name ',a3)
- end
-
+++ /dev/null
-c algorithm 611, collected algorithms from acm.
-c algorithm appeared in acm-trans. math. software, vol.9, no. 4,
-c dec., 1983, p. 503-524.
- integer function imdcon(k)
-c
- integer k
-c
-c *** return integer machine-dependent constants ***
-c
-c *** k = 1 means return standard output unit number. ***
-c *** k = 2 means return alternate output unit number. ***
-c *** k = 3 means return input unit number. ***
-c (note -- k = 2, 3 are used only by test programs.)
-c
-c +++ port version follows...
-c external i1mach
-c integer i1mach
-c integer mdperm(3)
-c data mdperm(1)/2/, mdperm(2)/4/, mdperm(3)/1/
-c imdcon = i1mach(mdperm(k))
-c +++ end of port version +++
-c
-c +++ non-port version follows...
- integer mdcon(3)
- data mdcon(1)/6/, mdcon(2)/8/, mdcon(3)/5/
- imdcon = mdcon(k)
-c +++ end of non-port version +++
-c
- 999 return
-c *** last card of imdcon follows ***
- end
- double precision function rmdcon(k)
-c
-c *** return machine dependent constants used by nl2sol ***
-c
-c +++ comments below contain data statements for various machines. +++
-c +++ to convert to another machine, place a c in column 1 of the +++
-c +++ data statement line(s) that correspond to the current machine +++
-c +++ and remove the c from column 1 of the data statement line(s) +++
-c +++ that correspond to the new machine. +++
-c
- integer k
-c
-c *** the constant returned depends on k...
-c
-c *** k = 1... smallest pos. eta such that -eta exists.
-c *** k = 2... square root of eta.
-c *** k = 3... unit roundoff = smallest pos. no. machep such
-c *** that 1 + machep .gt. 1 .and. 1 - machep .lt. 1.
-c *** k = 4... square root of machep.
-c *** k = 5... square root of big (see k = 6).
-c *** k = 6... largest machine no. big such that -big exists.
-c
- double precision big, eta, machep
- integer bigi(4), etai(4), machei(4)
-c/+
- double precision dsqrt
-c/
- equivalence (big,bigi(1)), (eta,etai(1)), (machep,machei(1))
-c
-c +++ ibm 360, ibm 370, or xerox +++
-c
-c data big/z7fffffffffffffff/, eta/z0010000000000000/,
-c 1 machep/z3410000000000000/
-c
-c +++ data general +++
-c
-c data big/0.7237005577d+76/, eta/0.5397605347d-78/,
-c 1 machep/2.22044605d-16/
-c
-c +++ dec 11 +++
-c
-c data big/1.7d+38/, eta/2.938735878d-39/, machep/2.775557562d-17/
-c
-c +++ hp3000 +++
-c
-c data big/1.157920892d+77/, eta/8.636168556d-78/,
-c 1 machep/5.551115124d-17/
-c
-c +++ honeywell +++
-c
-c data big/1.69d+38/, eta/5.9d-39/, machep/2.1680435d-19/
-c
-c +++ dec10 +++
-c
-c data big/"377777100000000000000000/,
-c 1 eta/"002400400000000000000000/,
-c 2 machep/"104400000000000000000000/
-c
-c +++ burroughs +++
-c
-c data big/o0777777777777777,o7777777777777777/,
-c 1 eta/o1771000000000000,o7770000000000000/,
-c 2 machep/o1451000000000000,o0000000000000000/
-c
-c +++ control data +++
-c
-c data big/37767777777777777777b,37167777777777777777b/,
-c 1 eta/00014000000000000000b,00000000000000000000b/,
-c 2 machep/15614000000000000000b,15010000000000000000b/
-c
-c +++ prime +++
-c
-c data big/1.0d+9786/, eta/1.0d-9860/, machep/1.4210855d-14/
-c
-c +++ univac +++
-c
-c data big/8.988d+307/, eta/1.2d-308/, machep/1.734723476d-18/
-c
-c +++ vax +++
-c
- data big/1.7d+38/, eta/2.939d-39/, machep/1.3877788d-17/
-c
-c +++ cray 1 +++
-c
-c data bigi(1)/577767777777777777777b/,
-c 1 bigi(2)/000007777777777777776b/,
-c 2 etai(1)/200004000000000000000b/,
-c 3 etai(2)/000000000000000000000b/,
-c 4 machei(1)/377224000000000000000b/,
-c 5 machei(2)/000000000000000000000b/
-c
-c +++ port library -- requires more than just a data statement... +++
-c
-c external d1mach
-c double precision d1mach, zero
-c data big/0.d+0/, eta/0.d+0/, machep/0.d+0/, zero/0.d+0/
-c if (big .gt. zero) go to 1
-c big = d1mach(2)
-c eta = d1mach(1)
-c machep = d1mach(4)
-c1 continue
-c
-c +++ end of port +++
-c
-c------------------------------- body --------------------------------
-c
- go to (10, 20, 30, 40, 50, 60), k
-c
- 10 rmdcon = eta
- go to 999
-c
- 20 rmdcon = dsqrt(256.d+0*eta)/16.d+0
- go to 999
-c
- 30 rmdcon = machep
- go to 999
-c
- 40 rmdcon = dsqrt(machep)
- go to 999
-c
- 50 rmdcon = dsqrt(big/256.d+0)*16.d+0
- go to 999
-c
- 60 rmdcon = big
-c
- 999 return
-c *** last card of rmdcon follows ***
- end
+++ /dev/null
- subroutine rms_nac_nnc(rms,frac,frac_nn,co,lprn)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.CONTACTS'
- include 'COMMON.IOUNITS'
- double precision przes(3),obr(3,3)
- logical non_conv,lprn
-c call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes,
-c & obr,non_conv)
-c rms=dsqrt(rms)
- call rmsd(rms)
- call contact(.false.,ncont,icont,co)
- frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
- frac_nn=contact_fract_nn(ncont,ncont_ref,icont,icont_ref)
- if (lprn) write (iout,'(a,f8.3/a,f8.3/a,f8.3/a,f8.3)')
- & 'RMS deviation from the reference structure:',rms,
- & ' % of native contacts:',frac*100,
- & ' % of nonnative contacts:',frac_nn*100,
- & ' contact order:',co
-
- return
- end
-c---------------------------------------------------------------------------
- subroutine rmsd(drms)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.INTERACT'
- logical non_conv
- double precision przes(3),obrot(3,3)
- double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2)
-
- iatom=0
-c print *,"nz_start",nz_start," nz_end",nz_end
- do i=nz_start,nz_end
- iatom=iatom+1
- iti=itype(i)
- do k=1,3
- ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup)
- crefcopy(k,iatom)=cref(k,i)
- enddo
- if (iz_sc.eq.1.and.iti.ne.10) then
- iatom=iatom+1
- do k=1,3
- ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup)
- crefcopy(k,iatom)=cref(k,nres+i)
- enddo
- endif
- enddo
-
-c ----- diagnostics
-c write (iout,*) 'Ccopy and CREFcopy'
-c print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
-c & (crefcopy(j,k),j=1,3),k=1,iatom)
-c write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
-c & (crefcopy(j,k),j=1,3),k=1,iatom)
-c ----- end diagnostics
-
- call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom,
- & przes,obrot,non_conv)
- if (non_conv) then
- print *,'Problems in FITSQ!!! rmsd'
- write (iout,*) 'Problems in FITSQ!!! rmsd'
- print *,'Ccopy and CREFcopy'
- write (iout,*) 'Ccopy and CREFcopy'
- print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
- & (crefcopy(j,k),j=1,3),k=1,iatom)
- write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
- & (crefcopy(j,k),j=1,3),k=1,iatom)
-#ifdef MPI
-c call mpi_abort(mpi_comm_world,ierror,ierrcode)
- roznica=100.0
-#else
- stop
-#endif
- endif
- drms=dsqrt(dabs(roznica))
-c ---- diagnostics
-c write (iout,*) "rms",drms
-c ---- end diagnostics
- return
- end
-
-c--------------------------------------------
- subroutine rmsd_csa(drms)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.INTERACT'
- logical non_conv
- double precision przes(3),obrot(3,3)
- double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2)
-
- iatom=0
- do i=nz_start,nz_end
- iatom=iatom+1
- iti=itype(i)
- do k=1,3
- ccopy(k,iatom)=c(k,i)
- crefcopy(k,iatom)=crefjlee(k,i)
- enddo
- if (iz_sc.eq.1.and.iti.ne.10) then
- iatom=iatom+1
- do k=1,3
- ccopy(k,iatom)=c(k,nres+i)
- crefcopy(k,iatom)=crefjlee(k,nres+i)
- enddo
- endif
- enddo
-
- call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom,
- & przes,obrot,non_conv)
- if (non_conv) then
- print *,'Problems in FITSQ!!! rmsd_csa'
- write (iout,*) 'Problems in FITSQ!!! rmsd_csa'
- print *,'Ccopy and CREFcopy'
- write (iout,*) 'Ccopy and CREFcopy'
- print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
- & (crefcopy(j,k),j=1,3),k=1,iatom)
- write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
- & (crefcopy(j,k),j=1,3),k=1,iatom)
-#ifdef MPI
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
-#else
- stop
-#endif
- endif
- drms=dsqrt(dabs(roznica))
- return
- end
-
+++ /dev/null
- subroutine sc_move(n_start,n_end,n_maxtry,e_drop,
- + n_fun,etot)
-c Perform a quick search over side-chain arrangments (over
-c residues n_start to n_end) for a given (frozen) CA trace
-c Only side-chains are minimized (at most n_maxtry times each),
-c not CA positions
-c Stops if energy drops by e_drop, otherwise tries all residues
-c in the given range
-c If there is an energy drop, full minimization may be useful
-c n_start, n_end CAN be modified by this routine, but only if
-c out of bounds (n_start <= 1, n_end >= nres, n_start < n_end)
-c NOTE: this move should never increase the energy
-crc implicit none
-
-c Includes
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.HEADER'
- include 'COMMON.IOUNITS'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
-
-c External functions
- integer iran_num
- external iran_num
-
-c Input arguments
- integer n_start,n_end,n_maxtry
- double precision e_drop
-
-c Output arguments
- integer n_fun
- double precision etot
-
-c Local variables
- double precision energy(0:n_ene)
- double precision cur_alph(2:nres-1),cur_omeg(2:nres-1)
- double precision orig_e,cur_e
- integer n,n_steps,n_first,n_cur,n_tot,i
- double precision orig_w(n_ene)
- double precision wtime
-
-
-c Set non side-chain weights to zero (minimization is faster)
-c NOTE: e(2) does not actually depend on the side-chain, only CA
- orig_w(2)=wscp
- orig_w(3)=welec
- orig_w(4)=wcorr
- orig_w(5)=wcorr5
- orig_w(6)=wcorr6
- orig_w(7)=wel_loc
- orig_w(8)=wturn3
- orig_w(9)=wturn4
- orig_w(10)=wturn6
- orig_w(11)=wang
- orig_w(13)=wtor
- orig_w(14)=wtor_d
- orig_w(15)=wvdwpp
-
- wscp=0.D0
- welec=0.D0
- wcorr=0.D0
- wcorr5=0.D0
- wcorr6=0.D0
- wel_loc=0.D0
- wturn3=0.D0
- wturn4=0.D0
- wturn6=0.D0
- wang=0.D0
- wtor=0.D0
- wtor_d=0.D0
- wvdwpp=0.D0
-
-c Make sure n_start, n_end are within proper range
- if (n_start.lt.2) n_start=2
- if (n_end.gt.nres-1) n_end=nres-1
-crc if (n_start.lt.n_end) then
- if (n_start.gt.n_end) then
- n_start=2
- n_end=nres-1
- endif
-
-c Save the initial values of energy and coordinates
-cd call chainbuild
-cd call etotal(energy)
-cd write (iout,*) 'start sc ene',energy(0)
-cd call enerprint(energy(0))
-crc etot=energy(0)
- n_fun=0
-crc orig_e=etot
-crc cur_e=orig_e
-crc do i=2,nres-1
-crc cur_alph(i)=alph(i)
-crc cur_omeg(i)=omeg(i)
-crc enddo
-
-ct wtime=MPI_WTIME()
-c Try (one by one) all specified residues, starting from a
-c random position in sequence
-c Stop early if the energy has decreased by at least e_drop
- n_tot=n_end-n_start+1
- n_first=iran_num(0,n_tot-1)
- n_steps=0
- n=0
-crc do while (n.lt.n_tot .and. orig_e-etot.lt.e_drop)
- do while (n.lt.n_tot)
- n_cur=n_start+mod(n_first+n,n_tot)
- call single_sc_move(n_cur,n_maxtry,e_drop,
- + n_steps,n_fun,etot)
-c If a lower energy was found, update the current structure...
-crc if (etot.lt.cur_e) then
-crc cur_e=etot
-crc do i=2,nres-1
-crc cur_alph(i)=alph(i)
-crc cur_omeg(i)=omeg(i)
-crc enddo
-crc else
-c ...else revert to the previous one
-crc etot=cur_e
-crc do i=2,nres-1
-crc alph(i)=cur_alph(i)
-crc omeg(i)=cur_omeg(i)
-crc enddo
-crc endif
- n=n+1
-cd
-cd call chainbuild
-cd call etotal(energy)
-cd print *,'running',n,energy(0)
- enddo
-
-cd call chainbuild
-cd call etotal(energy)
-cd write (iout,*) 'end sc ene',energy(0)
-
-c Put the original weights back to calculate the full energy
- wscp=orig_w(2)
- welec=orig_w(3)
- wcorr=orig_w(4)
- wcorr5=orig_w(5)
- wcorr6=orig_w(6)
- wel_loc=orig_w(7)
- wturn3=orig_w(8)
- wturn4=orig_w(9)
- wturn6=orig_w(10)
- wang=orig_w(11)
- wtor=orig_w(13)
- wtor_d=orig_w(14)
- wvdwpp=orig_w(15)
-
-crc n_fun=n_fun+1
-ct write (iout,*) 'sc_local time= ',MPI_WTIME()-wtime
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine single_sc_move(res_pick,n_maxtry,e_drop,
- + n_steps,n_fun,e_sc)
-c Perturb one side-chain (res_pick) and minimize the
-c neighbouring region, keeping all CA's and non-neighbouring
-c side-chains fixed
-c Try until e_drop energy improvement is achieved, or n_maxtry
-c attempts have been made
-c At the start, e_sc should contain the side-chain-only energy(0)
-c nsteps and nfun for this move are ADDED to n_steps and n_fun
-crc implicit none
-
-c Includes
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.CHAIN'
- include 'COMMON.MINIM'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
-
-c External functions
- double precision dist
- external dist
-
-c Input arguments
- integer res_pick,n_maxtry
- double precision e_drop
-
-c Input/Output arguments
- integer n_steps,n_fun
- double precision e_sc
-
-c Local variables
- logical fail
- integer i,j
- integer nres_moved
- integer iretcode,loc_nfun,orig_maxfun,n_try
- double precision sc_dist,sc_dist_cutoff
- double precision energy(0:n_ene),orig_e,cur_e
- double precision evdw,escloc
- double precision cur_alph(2:nres-1),cur_omeg(2:nres-1)
- double precision var(maxvar)
-
- double precision orig_theta(1:nres),orig_phi(1:nres),
- + orig_alph(1:nres),orig_omeg(1:nres)
-
-
-c Define what is meant by "neighbouring side-chain"
- sc_dist_cutoff=5.0D0
-
-c Don't do glycine or ends
- i=itype(res_pick)
- if (i.eq.10 .or. i.eq.21) return
-
-c Freeze everything (later will relax only selected side-chains)
- mask_r=.true.
- do i=1,nres
- mask_phi(i)=0
- mask_theta(i)=0
- mask_side(i)=0
- enddo
-
-c Find the neighbours of the side-chain to move
-c and save initial variables
-crc orig_e=e_sc
-crc cur_e=orig_e
- nres_moved=0
- do i=2,nres-1
-c Don't do glycine (itype(j)==10)
- if (itype(i).ne.10) then
- sc_dist=dist(nres+i,nres+res_pick)
- else
- sc_dist=sc_dist_cutoff
- endif
- if (sc_dist.lt.sc_dist_cutoff) then
- nres_moved=nres_moved+1
- mask_side(i)=1
- cur_alph(i)=alph(i)
- cur_omeg(i)=omeg(i)
- endif
- enddo
-
- call chainbuild
- call egb1(evdw)
- call esc(escloc)
- e_sc=wsc*evdw+wscloc*escloc
-cd call etotal(energy)
-cd print *,'new ',(energy(k),k=0,n_ene)
- orig_e=e_sc
- cur_e=orig_e
-
- n_try=0
- do while (n_try.lt.n_maxtry .and. orig_e-cur_e.lt.e_drop)
-c Move the selected residue (don't worry if it fails)
- call gen_side(itype(res_pick),theta(res_pick+1),
- + alph(res_pick),omeg(res_pick),fail)
-
-c Minimize the side-chains starting from the new arrangement
- call geom_to_var(nvar,var)
- orig_maxfun=maxfun
- maxfun=7
-
-crc do i=1,nres
-crc orig_theta(i)=theta(i)
-crc orig_phi(i)=phi(i)
-crc orig_alph(i)=alph(i)
-crc orig_omeg(i)=omeg(i)
-crc enddo
-
- call minimize_sc1(e_sc,var,iretcode,loc_nfun)
-
-cv write(*,'(2i3,2f12.5,2i3)')
-cv & res_pick,nres_moved,orig_e,e_sc-cur_e,
-cv & iretcode,loc_nfun
-
-c$$$ if (iretcode.eq.8) then
-c$$$ write(iout,*)'Coordinates just after code 8'
-c$$$ call chainbuild
-c$$$ call all_varout
-c$$$ call flush(iout)
-c$$$ do i=1,nres
-c$$$ theta(i)=orig_theta(i)
-c$$$ phi(i)=orig_phi(i)
-c$$$ alph(i)=orig_alph(i)
-c$$$ omeg(i)=orig_omeg(i)
-c$$$ enddo
-c$$$ write(iout,*)'Coordinates just before code 8'
-c$$$ call chainbuild
-c$$$ call all_varout
-c$$$ call flush(iout)
-c$$$ endif
-
- n_fun=n_fun+loc_nfun
- maxfun=orig_maxfun
- call var_to_geom(nvar,var)
-
-c If a lower energy was found, update the current structure...
- if (e_sc.lt.cur_e) then
-cv call chainbuild
-cv call etotal(energy)
-cd call egb1(evdw)
-cd call esc(escloc)
-cd e_sc1=wsc*evdw+wscloc*escloc
-cd print *,' new',e_sc1,energy(0)
-cv print *,'new ',energy(0)
-cd call enerprint(energy(0))
- cur_e=e_sc
- do i=2,nres-1
- if (mask_side(i).eq.1) then
- cur_alph(i)=alph(i)
- cur_omeg(i)=omeg(i)
- endif
- enddo
- else
-c ...else revert to the previous one
- e_sc=cur_e
- do i=2,nres-1
- if (mask_side(i).eq.1) then
- alph(i)=cur_alph(i)
- omeg(i)=cur_omeg(i)
- endif
- enddo
- endif
- n_try=n_try+1
-
- enddo
- n_steps=n_steps+n_try
-
-c Reset the minimization mask_r to false
- mask_r=.false.
-
- return
- end
-
-c-------------------------------------------------------------
-
- subroutine sc_minimize(etot,iretcode,nfun)
-c Minimizes side-chains only, leaving backbone frozen
-crc implicit none
-
-c Includes
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.FFIELD'
-
-c Output arguments
- double precision etot
- integer iretcode,nfun
-
-c Local variables
- integer i
- double precision orig_w(n_ene),energy(0:n_ene)
- double precision var(maxvar)
-
-
-c Set non side-chain weights to zero (minimization is faster)
-c NOTE: e(2) does not actually depend on the side-chain, only CA
- orig_w(2)=wscp
- orig_w(3)=welec
- orig_w(4)=wcorr
- orig_w(5)=wcorr5
- orig_w(6)=wcorr6
- orig_w(7)=wel_loc
- orig_w(8)=wturn3
- orig_w(9)=wturn4
- orig_w(10)=wturn6
- orig_w(11)=wang
- orig_w(13)=wtor
- orig_w(14)=wtor_d
-
- wscp=0.D0
- welec=0.D0
- wcorr=0.D0
- wcorr5=0.D0
- wcorr6=0.D0
- wel_loc=0.D0
- wturn3=0.D0
- wturn4=0.D0
- wturn6=0.D0
- wang=0.D0
- wtor=0.D0
- wtor_d=0.D0
-
-c Prepare to freeze backbone
- do i=1,nres
- mask_phi(i)=0
- mask_theta(i)=0
- mask_side(i)=1
- enddo
-
-c Minimize the side-chains
- mask_r=.true.
- call geom_to_var(nvar,var)
- call minimize(etot,var,iretcode,nfun)
- call var_to_geom(nvar,var)
- mask_r=.false.
-
-c Put the original weights back and calculate the full energy
- wscp=orig_w(2)
- welec=orig_w(3)
- wcorr=orig_w(4)
- wcorr5=orig_w(5)
- wcorr6=orig_w(6)
- wel_loc=orig_w(7)
- wturn3=orig_w(8)
- wturn4=orig_w(9)
- wturn6=orig_w(10)
- wang=orig_w(11)
- wtor=orig_w(13)
- wtor_d=orig_w(14)
-
- call chainbuild
- call etotal(energy)
- etot=energy(0)
-
- return
- end
-
-c-------------------------------------------------------------
- subroutine minimize_sc1(etot,x,iretcode,nfun)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.GEO'
- include 'COMMON.MINIM'
- common /srutu/ icall
- dimension iv(liv)
- double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar)
- double precision energia(0:n_ene)
- external func,gradient,fdum
- external func_restr1,grad_restr1
- logical not_done,change,reduce
- common /przechowalnia/ v
-
- call deflt(2,iv,liv,lv,v)
-* 12 means fresh start, dont call deflt
- iv(1)=12
-* max num of fun calls
- if (maxfun.eq.0) maxfun=500
- iv(17)=maxfun
-* max num of iterations
- if (maxmin.eq.0) maxmin=1000
- iv(18)=maxmin
-* controls output
- iv(19)=2
-* selects output unit
-c iv(21)=iout
- iv(21)=0
-* 1 means to print out result
- iv(22)=0
-* 1 means to print out summary stats
- iv(23)=0
-* 1 means to print initial x and d
- iv(24)=0
-* min val for v(radfac) default is 0.1
- v(24)=0.1D0
-* max val for v(radfac) default is 4.0
- v(25)=2.0D0
-c v(25)=4.0D0
-* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
-* the sumsl default is 0.1
- v(26)=0.1D0
-* false conv if (act fnctn decrease) .lt. v(34)
-* the sumsl default is 100*machep
- v(34)=v(34)/100.0D0
-* absolute convergence
- if (tolf.eq.0.0D0) tolf=1.0D-4
- v(31)=tolf
-* relative convergence
- if (rtolf.eq.0.0D0) rtolf=1.0D-4
- v(32)=rtolf
-* controls initial step size
- v(35)=1.0D-1
-* large vals of d correspond to small components of step
- do i=1,nphi
- d(i)=1.0D-1
- enddo
- do i=nphi+1,nvar
- d(i)=1.0D-1
- enddo
- IF (mask_r) THEN
- call x2xx(x,xx,nvar_restr)
- call sumsl(nvar_restr,d,xx,func_restr1,grad_restr1,
- & iv,liv,lv,v,idum,rdum,fdum)
- call xx2x(x,xx)
- ELSE
- call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
- ENDIF
- etot=v(10)
- iretcode=iv(1)
- nfun=iv(6)
-
- return
- end
-************************************************************************
- subroutine func_restr1(n,x,nf,f,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.DERIV'
- include 'COMMON.IOUNITS'
- include 'COMMON.GEO'
- include 'COMMON.FFIELD'
- include 'COMMON.INTERACT'
- include 'COMMON.TIME1'
- common /chuju/ jjj
- double precision energia(0:n_ene),evdw,escloc
- integer jjj
- double precision ufparm,e1,e2
- external ufparm
- integer uiparm(1)
- real*8 urparm(1)
- dimension x(maxvar)
- nfl=nf
- icg=mod(nf,2)+1
-
-#ifdef OSF
-c Intercept NaNs in the coordinates, before calling etotal
- x_sum=0.D0
- do i=1,n
- x_sum=x_sum+x(i)
- enddo
- FOUND_NAN=.false.
- if (x_sum.ne.x_sum) then
- write(iout,*)" *** func_restr1 : Found NaN in coordinates"
- f=1.0D+73
- FOUND_NAN=.true.
- return
- endif
-#endif
-
- call var_to_geom_restr(n,x)
- call zerograd
- call chainbuild
-cd write (iout,*) 'ETOTAL called from FUNC'
- call egb1(evdw)
- call esc(escloc)
- f=wsc*evdw+wscloc*escloc
-cd call etotal(energia(0))
-cd f=wsc*energia(1)+wscloc*energia(12)
-cd print *,f,evdw,escloc,energia(0)
-C
-C Sum up the components of the Cartesian gradient.
-C
- do i=1,nct
- do j=1,3
- gradx(j,i,icg)=wsc*gvdwx(j,i)
- enddo
- enddo
-
- return
- end
-c-------------------------------------------------------
- subroutine grad_restr1(n,x,nf,g,uiparm,urparm,ufparm)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.FFIELD'
- include 'COMMON.IOUNITS'
- external ufparm
- integer uiparm(1)
- double precision urparm(1)
- dimension x(maxvar),g(maxvar)
-
- icg=mod(nf,2)+1
- if (nf-nfl+1) 20,30,40
- 20 call func_restr1(n,x,nf,f,uiparm,urparm,ufparm)
-c write (iout,*) 'grad 20'
- if (nf.eq.0) return
- goto 40
- 30 call var_to_geom_restr(n,x)
- call chainbuild
-C
-C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-C
- 40 call cartder
-C
-C Convert the Cartesian gradient into internal-coordinate gradient.
-C
-
- ig=0
- ind=nres-2
- do i=2,nres-2
- IF (mask_phi(i+2).eq.1) THEN
- gphii=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
- enddo
- enddo
- ig=ig+1
- g(ig)=gphii
- ELSE
- ind=ind+nres-1-i
- ENDIF
- enddo
-
-
- ind=0
- do i=1,nres-2
- IF (mask_theta(i+2).eq.1) THEN
- ig=ig+1
- gthetai=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
- enddo
- enddo
- g(ig)=gthetai
- ELSE
- ind=ind+nres-1-i
- ENDIF
- enddo
-
- do i=2,nres-1
- if (itype(i).ne.10) then
- IF (mask_side(i).eq.1) THEN
- ig=ig+1
- galphai=0.0D0
- do k=1,3
- galphai=galphai+dxds(k,i)*gradx(k,i,icg)
- enddo
- g(ig)=galphai
- ENDIF
- endif
- enddo
-
-
- do i=2,nres-1
- if (itype(i).ne.10) then
- IF (mask_side(i).eq.1) THEN
- ig=ig+1
- gomegai=0.0D0
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
- enddo
- g(ig)=gomegai
- ENDIF
- endif
- enddo
-
-C
-C Add the components corresponding to local energy terms.
-C
-
- ig=0
- igall=0
- do i=4,nres
- igall=igall+1
- if (mask_phi(i).eq.1) then
- ig=ig+1
- g(ig)=g(ig)+gloc(igall,icg)
- endif
- enddo
-
- do i=3,nres
- igall=igall+1
- if (mask_theta(i).eq.1) then
- ig=ig+1
- g(ig)=g(ig)+gloc(igall,icg)
- endif
- enddo
-
- do ij=1,2
- do i=2,nres-1
- if (itype(i).ne.10) then
- igall=igall+1
- if (mask_side(i).eq.1) then
- ig=ig+1
- g(ig)=g(ig)+gloc(igall,icg)
- endif
- endif
- enddo
- enddo
-
-cd do i=1,ig
-cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
-cd enddo
- return
- end
-C-----------------------------------------------------------------------------
- subroutine egb1(evdw)
-C
-C This subroutine calculates the interaction energy of nonbonded side chains
-C assuming the Gay-Berne potential of interaction.
-C
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.LOCAL'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.NAMES'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
- include 'COMMON.CONTROL'
- logical lprn
- evdw=0.0D0
-c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
- evdw=0.0D0
- lprn=.false.
-c if (icall.eq.0) lprn=.true.
- ind=0
- do i=iatsc_s,iatsc_e
-
-
- itypi=itype(i)
- itypi1=itype(i+1)
- xi=c(1,nres+i)
- yi=c(2,nres+i)
- zi=c(3,nres+i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=dsc_inv(itypi)
-C
-C Calculate SC interaction energy.
-C
- do iint=1,nint_gr(i)
- do j=istart(i,iint),iend(i,iint)
- IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN
- ind=ind+1
- itypj=itype(j)
- dscj_inv=dsc_inv(itypj)
- sig0ij=sigma(itypi,itypj)
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-C For diagnostics only!!!
-c chi1=0.0D0
-c chi2=0.0D0
-c chi12=0.0D0
-c chip1=0.0D0
-c chip2=0.0D0
-c chip12=0.0D0
-c alf1=0.0D0
-c alf2=0.0D0
-c alf12=0.0D0
- xj=c(1,nres+j)-xi
- yj=c(2,nres+j)-yi
- zj=c(3,nres+j)-zi
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij)
-C Calculate angle-dependent terms of energy and contributions to their
-C derivatives.
- call sc_angular
- sigsq=1.0D0/sigsq
- sig=sig0ij*dsqrt(sigsq)
- rij_shift=1.0D0/rij-sig+sig0ij
-C I hate to put IF's in the loops, but here don't have another choice!!!!
- if (rij_shift.le.0.0D0) then
- evdw=1.0D20
-cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
- return
- endif
- sigder=-sig*sigsq
-c---------------------------------------------------------------
- rij_shift=1.0D0/rij_shift
- fac=rij_shift**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- evdwij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=evdwij*eps3rt
- eps3der=evdwij*eps2rt
- evdwij=evdwij*eps2rt*eps3rt
- evdw=evdw+evdwij
- if (lprn) then
- sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
- epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-cd & restyp(itypi),i,restyp(itypj),j,
-cd & epsi,sigm,chi1,chi2,chip1,chip2,
-cd & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
-cd & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-cd & evdwij
- endif
-
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw',i,j,evdwij
-
-C Calculate gradient components.
- e1=e1*eps1*eps2rt**2*eps3rt**2
- fac=-expon*(e1+evdwij)*rij_shift
- sigder=fac*sigder
- fac=rij*fac
-C Calculate the radial part of the gradient
- gg(1)=xj*fac
- gg(2)=yj*fac
- gg(3)=zj*fac
-C Calculate angular part of the gradient.
- call sc_grad
- ENDIF
- enddo ! j
- enddo ! iint
- enddo ! i
- end
-C-----------------------------------------------------------------------------
+++ /dev/null
-c
-c
-c ###################################################
-c ## COPYRIGHT (C) 1992 by Jay William Ponder ##
-c ## All Rights Reserved ##
-c ###################################################
-c
-c #############################################################
-c ## ##
-c ## sizes.i -- parameter values to set array dimensions ##
-c ## ##
-c #############################################################
-c
-c
-c "sizes.i" sets values for critical array dimensions used
-c throughout the software; these parameters will fix the size
-c of the largest systems that can be handled; values too large
-c for the computer's memory and/or swap space to accomodate
-c will result in poor performance or outright failure
-c
-c parameter: maximum allowed number of:
-c
-c maxatm atoms in the molecular system
-c maxval atoms directly bonded to an atom
-c maxgrp user-defined groups of atoms
-c maxtyp force field atom type definitions
-c maxclass force field atom class definitions
-c maxkey lines in the keyword file
-c maxrot bonds for torsional rotation
-c maxvar optimization variables (vector storage)
-c maxopt optimization variables (matrix storage)
-c maxhess off-diagonal Hessian elements
-c maxlight sites for method of lights neighbors
-c maxvib vibrational frequencies
-c maxgeo distance geometry points
-c maxcell unit cells in replicated crystal
-c maxring 3-, 4-, or 5-membered rings
-c maxfix geometric restraints
-c maxbio biopolymer atom definitions
-c maxres residues in the macromolecule
-c maxamino amino acid residue types
-c maxnuc nucleic acid residue types
-c maxbnd covalent bonds in molecular system
-c maxang bond angles in molecular system
-c maxtors torsional angles in molecular system
-c maxpi atoms in conjugated pisystem
-c maxpib covalent bonds involving pisystem
-c maxpit torsional angles involving pisystem
-c
-c
- integer maxatm,maxval,maxgrp
- integer maxtyp,maxclass,maxkey
- integer maxrot,maxopt
- integer maxhess,maxlight,maxvib
- integer maxgeo,maxcell,maxring
- integer maxfix,maxbio
- integer maxamino,maxnuc,maxbnd
- integer maxang,maxtors,maxpi
- integer maxpib,maxpit
- parameter (maxatm=maxres2)
- parameter (maxval=8)
- parameter (maxgrp=1000)
- parameter (maxtyp=3000)
- parameter (maxclass=500)
- parameter (maxkey=10000)
- parameter (maxrot=1000)
- parameter (maxopt=1000)
- parameter (maxhess=1000000)
- parameter (maxlight=8*maxatm)
- parameter (maxvib=1000)
- parameter (maxgeo=1000)
- parameter (maxcell=10000)
- parameter (maxring=10000)
- parameter (maxfix=10000)
- parameter (maxbio=10000)
- parameter (maxamino=31)
- parameter (maxnuc=12)
- parameter (maxbnd=2*maxatm)
- parameter (maxang=3*maxatm)
- parameter (maxtors=4*maxatm)
- parameter (maxpi=100)
- parameter (maxpib=2*maxpi)
- parameter (maxpit=4*maxpi)
+++ /dev/null
-c
-c
-c ###################################################
-c ## COPYRIGHT (C) 1990 by Jay William Ponder ##
-c ## All Rights Reserved ##
-c ###################################################
-c
-c #########################################################
-c ## ##
-c ## subroutine sort -- heapsort of an integer array ##
-c ## ##
-c #########################################################
-c
-c
-c "sort" takes an input list of integers and sorts it
-c into ascending order using the Heapsort algorithm
-c
-c
- subroutine sort (n,list)
- implicit none
- integer i,j,k,n
- integer index,lists
- integer list(*)
-c
-c
-c perform the heapsort of the input list
-c
- k = n/2 + 1
- index = n
- dowhile (n .gt. 1)
- if (k .gt. 1) then
- k = k - 1
- lists = list(k)
- else
- lists = list(index)
- list(index) = list(1)
- index = index - 1
- if (index .le. 1) then
- list(1) = lists
- return
- end if
- end if
- i = k
- j = k + k
- dowhile (j .le. index)
- if (j .lt. index) then
- if (list(j) .lt. list(j+1)) j = j + 1
- end if
- if (lists .lt. list(j)) then
- list(i) = list(j)
- i = j
- j = j + j
- else
- j = index + 1
- end if
- end do
- list(i) = lists
- end do
- return
- end
-c
-c
-c ##############################################################
-c ## ##
-c ## subroutine sort2 -- heapsort of real array with keys ##
-c ## ##
-c ##############################################################
-c
-c
-c "sort2" takes an input list of reals and sorts it
-c into ascending order using the Heapsort algorithm;
-c it also returns a key into the original ordering
-c
-c
- subroutine sort2 (n,list,key)
- implicit none
- integer i,j,k,n
- integer index,keys
- integer key(*)
- real*8 lists
- real*8 list(*)
-c
-c
-c initialize index into the original ordering
-c
- do i = 1, n
- key(i) = i
- end do
-c
-c perform the heapsort of the input list
-c
- k = n/2 + 1
- index = n
- dowhile (n .gt. 1)
- if (k .gt. 1) then
- k = k - 1
- lists = list(k)
- keys = key(k)
- else
- lists = list(index)
- keys = key(index)
- list(index) = list(1)
- key(index) = key(1)
- index = index - 1
- if (index .le. 1) then
- list(1) = lists
- key(1) = keys
- return
- end if
- end if
- i = k
- j = k + k
- dowhile (j .le. index)
- if (j .lt. index) then
- if (list(j) .lt. list(j+1)) j = j + 1
- end if
- if (lists .lt. list(j)) then
- list(i) = list(j)
- key(i) = key(j)
- i = j
- j = j + j
- else
- j = index + 1
- end if
- end do
- list(i) = lists
- key(i) = keys
- end do
- return
- end
-c
-c
-c #################################################################
-c ## ##
-c ## subroutine sort3 -- heapsort of integer array with keys ##
-c ## ##
-c #################################################################
-c
-c
-c "sort3" takes an input list of integers and sorts it
-c into ascending order using the Heapsort algorithm;
-c it also returns a key into the original ordering
-c
-c
- subroutine sort3 (n,list,key)
- implicit none
- integer i,j,k,n
- integer index
- integer lists
- integer keys
- integer list(*)
- integer key(*)
-c
-c
-c initialize index into the original ordering
-c
- do i = 1, n
- key(i) = i
- end do
-c
-c perform the heapsort of the input list
-c
- k = n/2 + 1
- index = n
- dowhile (n .gt. 1)
- if (k .gt. 1) then
- k = k - 1
- lists = list(k)
- keys = key(k)
- else
- lists = list(index)
- keys = key(index)
- list(index) = list(1)
- key(index) = key(1)
- index = index - 1
- if (index .le. 1) then
- list(1) = lists
- key(1) = keys
- return
- end if
- end if
- i = k
- j = k + k
- dowhile (j .le. index)
- if (j .lt. index) then
- if (list(j) .lt. list(j+1)) j = j + 1
- end if
- if (lists .lt. list(j)) then
- list(i) = list(j)
- key(i) = key(j)
- i = j
- j = j + j
- else
- j = index + 1
- end if
- end do
- list(i) = lists
- key(i) = keys
- end do
- return
- end
-c
-c
-c #################################################################
-c ## ##
-c ## subroutine sort4 -- heapsort of integer absolute values ##
-c ## ##
-c #################################################################
-c
-c
-c "sort4" takes an input list of integers and sorts it into
-c ascending absolute value using the Heapsort algorithm
-c
-c
- subroutine sort4 (n,list)
- implicit none
- integer i,j,k,n
- integer index
- integer lists
- integer list(*)
-c
-c
-c perform the heapsort of the input list
-c
- k = n/2 + 1
- index = n
- dowhile (n .gt. 1)
- if (k .gt. 1) then
- k = k - 1
- lists = list(k)
- else
- lists = list(index)
- list(index) = list(1)
- index = index - 1
- if (index .le. 1) then
- list(1) = lists
- return
- end if
- end if
- i = k
- j = k + k
- dowhile (j .le. index)
- if (j .lt. index) then
- if (abs(list(j)) .lt. abs(list(j+1))) j = j + 1
- end if
- if (abs(lists) .lt. abs(list(j))) then
- list(i) = list(j)
- i = j
- j = j + j
- else
- j = index + 1
- end if
- end do
- list(i) = lists
- end do
- return
- end
-c
-c
-c ################################################################
-c ## ##
-c ## subroutine sort5 -- heapsort of integer array modulo m ##
-c ## ##
-c ################################################################
-c
-c
-c "sort5" takes an input list of integers and sorts it
-c into ascending order based on each value modulo "m"
-c
-c
- subroutine sort5 (n,list,m)
- implicit none
- integer i,j,k,m,n
- integer index,smod
- integer jmod,j1mod
- integer lists
- integer list(*)
-c
-c
-c perform the heapsort of the input list
-c
- k = n/2 + 1
- index = n
- dowhile (n .gt. 1)
- if (k .gt. 1) then
- k = k - 1
- lists = list(k)
- else
- lists = list(index)
- list(index) = list(1)
- index = index - 1
- if (index .le. 1) then
- list(1) = lists
- return
- end if
- end if
- i = k
- j = k + k
- dowhile (j .le. index)
- if (j .lt. index) then
- jmod = mod(list(j),m)
- j1mod = mod(list(j+1),m)
- if (jmod .lt. j1mod) then
- j = j + 1
- else if (jmod.eq.j1mod .and. list(j).lt.list(j+1)) then
- j = j + 1
- end if
- end if
- smod = mod(lists,m)
- jmod = mod(list(j),m)
- if (smod .lt. jmod) then
- list(i) = list(j)
- i = j
- j = j + j
- else if (smod.eq.jmod .and. lists.lt.list(j)) then
- list(i) = list(j)
- i = j
- j = j + j
- else
- j = index + 1
- end if
- end do
- list(i) = lists
- end do
- return
- end
-c
-c
-c #############################################################
-c ## ##
-c ## subroutine sort6 -- heapsort of a text string array ##
-c ## ##
-c #############################################################
-c
-c
-c "sort6" takes an input list of character strings and sorts
-c it into alphabetical order using the Heapsort algorithm
-c
-c
- subroutine sort6 (n,list)
- implicit none
- integer i,j,k,n
- integer index
- character*256 lists
- character*(*) list(*)
-c
-c
-c perform the heapsort of the input list
-c
- k = n/2 + 1
- index = n
- dowhile (n .gt. 1)
- if (k .gt. 1) then
- k = k - 1
- lists = list(k)
- else
- lists = list(index)
- list(index) = list(1)
- index = index - 1
- if (index .le. 1) then
- list(1) = lists
- return
- end if
- end if
- i = k
- j = k + k
- dowhile (j .le. index)
- if (j .lt. index) then
- if (list(j) .lt. list(j+1)) j = j + 1
- end if
- if (lists .lt. list(j)) then
- list(i) = list(j)
- i = j
- j = j + j
- else
- j = index + 1
- end if
- end do
- list(i) = lists
- end do
- return
- end
-c
-c
-c ################################################################
-c ## ##
-c ## subroutine sort7 -- heapsort of text strings with keys ##
-c ## ##
-c ################################################################
-c
-c
-c "sort7" takes an input list of character strings and sorts it
-c into alphabetical order using the Heapsort algorithm; it also
-c returns a key into the original ordering
-c
-c
- subroutine sort7 (n,list,key)
- implicit none
- integer i,j,k,n
- integer index
- integer keys
- integer key(*)
- character*256 lists
- character*(*) list(*)
-c
-c
-c initialize index into the original ordering
-c
- do i = 1, n
- key(i) = i
- end do
-c
-c perform the heapsort of the input list
-c
- k = n/2 + 1
- index = n
- dowhile (n .gt. 1)
- if (k .gt. 1) then
- k = k - 1
- lists = list(k)
- keys = key(k)
- else
- lists = list(index)
- keys = key(index)
- list(index) = list(1)
- key(index) = key(1)
- index = index - 1
- if (index .le. 1) then
- list(1) = lists
- key(1) = keys
- return
- end if
- end if
- i = k
- j = k + k
- dowhile (j .le. index)
- if (j .lt. index) then
- if (list(j) .lt. list(j+1)) j = j + 1
- end if
- if (lists .lt. list(j)) then
- list(i) = list(j)
- key(i) = key(j)
- i = j
- j = j + j
- else
- j = index + 1
- end if
- end do
- list(i) = lists
- key(i) = keys
- end do
- return
- end
-c
-c
-c #########################################################
-c ## ##
-c ## subroutine sort8 -- heapsort to unique integers ##
-c ## ##
-c #########################################################
-c
-c
-c "sort8" takes an input list of integers and sorts it into
-c ascending order using the Heapsort algorithm, duplicate
-c values are removed from the final sorted list
-c
-c
- subroutine sort8 (n,list)
- implicit none
- integer i,j,k,n
- integer index
- integer lists
- integer list(*)
-c
-c
-c perform the heapsort of the input list
-c
- k = n/2 + 1
- index = n
- dowhile (n .gt. 1)
- if (k .gt. 1) then
- k = k - 1
- lists = list(k)
- else
- lists = list(index)
- list(index) = list(1)
- index = index - 1
- if (index .le. 1) then
- list(1) = lists
-c
-c remove duplicate values from final list
-c
- j = 1
- do i = 2, n
- if (list(i-1) .ne. list(i)) then
- j = j + 1
- list(j) = list(i)
- end if
- end do
- if (j .lt. n) n = j
- return
- end if
- end if
- i = k
- j = k + k
- dowhile (j .le. index)
- if (j .lt. index) then
- if (list(j) .lt. list(j+1)) j = j + 1
- end if
- if (lists .lt. list(j)) then
- list(i) = list(j)
- i = j
- j = j + j
- else
- j = index + 1
- end if
- end do
- list(i) = lists
- end do
- return
- end
-c
-c
-c #############################################################
-c ## ##
-c ## subroutine sort9 -- heapsort to unique text strings ##
-c ## ##
-c #############################################################
-c
-c
-c "sort9" takes an input list of character strings and sorts
-c it into alphabetical order using the Heapsort algorithm,
-c duplicate values are removed from the final sorted list
-c
-c
- subroutine sort9 (n,list)
- implicit none
- integer i,j,k,n
- integer index
- character*256 lists
- character*(*) list(*)
-c
-c
-c perform the heapsort of the input list
-c
- k = n/2 + 1
- index = n
- dowhile (n .gt. 1)
- if (k .gt. 1) then
- k = k - 1
- lists = list(k)
- else
- lists = list(index)
- list(index) = list(1)
- index = index - 1
- if (index .le. 1) then
- list(1) = lists
-c
-c remove duplicate values from final list
-c
- j = 1
- do i = 2, n
- if (list(i-1) .ne. list(i)) then
- j = j + 1
- list(j) = list(i)
- end if
- end do
- if (j .lt. n) n = j
- return
- end if
- end if
- i = k
- j = k + k
- dowhile (j .le. index)
- if (j .lt. index) then
- if (list(j) .lt. list(j+1)) j = j + 1
- end if
- if (lists .lt. list(j)) then
- list(i) = list(j)
- i = j
- j = j + j
- else
- j = index + 1
- end if
- end do
- list(i) = lists
- end do
- return
- end
+++ /dev/null
-c----------------------------------------------------------------------------
- subroutine check_energies
-c implicit none
-
-c Includes
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.LOCAL'
- include 'COMMON.GEO'
-
-c External functions
- double precision ran_number
- external ran_number
-
-c Local variables
- integer i,j,k,l,lmax,p,pmax
- double precision rmin,rmax
- double precision eij
-
- double precision d
- double precision wi,rij,tj,pj
-
-
-c return
-
- i=5
- j=14
-
- d=dsc(1)
- rmin=2.0D0
- rmax=12.0D0
-
- lmax=10000
- pmax=1
-
- do k=1,3
- c(k,i)=0.0D0
- c(k,j)=0.0D0
- c(k,nres+i)=0.0D0
- c(k,nres+j)=0.0D0
- enddo
-
- do l=1,lmax
-
-ct wi=ran_number(0.0D0,pi)
-c wi=ran_number(0.0D0,pi/6.0D0)
-c wi=0.0D0
-ct tj=ran_number(0.0D0,pi)
-ct pj=ran_number(0.0D0,pi)
-c pj=ran_number(0.0D0,pi/6.0D0)
-c pj=0.0D0
-
- do p=1,pmax
-ct rij=ran_number(rmin,rmax)
-
- c(1,j)=d*sin(pj)*cos(tj)
- c(2,j)=d*sin(pj)*sin(tj)
- c(3,j)=d*cos(pj)
-
- c(3,nres+i)=-rij
-
- c(1,i)=d*sin(wi)
- c(3,i)=-rij-d*cos(wi)
-
- do k=1,3
- dc(k,nres+i)=c(k,nres+i)-c(k,i)
- dc_norm(k,nres+i)=dc(k,nres+i)/d
- dc(k,nres+j)=c(k,nres+j)-c(k,j)
- dc_norm(k,nres+j)=dc(k,nres+j)/d
- enddo
-
- call dyn_ssbond_ene(i,j,eij)
- enddo
- enddo
-
- call exit(1)
-
- return
- end
-
-C-----------------------------------------------------------------------------
-
- subroutine dyn_ssbond_ene(resi,resj,eij)
-c implicit none
-
-c Includes
- include 'DIMENSIONS'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.CALC'
-#ifndef CLUST
-#ifndef WHAM
- include 'COMMON.MD'
-#endif
-#endif
-
-c External functions
- double precision h_base
- external h_base
-
-c Input arguments
- integer resi,resj
-
-c Output arguments
- double precision eij
-
-c Local variables
- logical havebond
-c integer itypi,itypj,k,l
- double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
- double precision sig0ij,ljd,sig,fac,e1,e2
- double precision dcosom1(3),dcosom2(3),ed
- double precision pom1,pom2
- double precision ljA,ljB,ljXs
- double precision d_ljB(1:3)
- double precision ssA,ssB,ssC,ssXs
- double precision ssxm,ljxm,ssm,ljm
- double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
- double precision f1,f2,h1,h2,hd1,hd2
- double precision omega,delta_inv,deltasq_inv,fac1,fac2
-c-------FIRST METHOD
- double precision xm,d_xm(1:3)
-c-------END FIRST METHOD
-c-------SECOND METHOD
-c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
-c-------END SECOND METHOD
-
-c-------TESTING CODE
- logical checkstop,transgrad
- common /sschecks/ checkstop,transgrad
-
- integer icheck,nicheck,jcheck,njcheck
- double precision echeck(-1:1),deps,ssx0,ljx0
-c-------END TESTING CODE
-
-
- i=resi
- j=resj
-
- itypi=itype(i)
- dxi=dc_norm(1,nres+i)
- dyi=dc_norm(2,nres+i)
- dzi=dc_norm(3,nres+i)
- dsci_inv=vbld_inv(i+nres)
-
- itypj=itype(j)
- xj=c(1,nres+j)-c(1,nres+i)
- yj=c(2,nres+j)-c(2,nres+i)
- zj=c(3,nres+j)-c(3,nres+i)
- dxj=dc_norm(1,nres+j)
- dyj=dc_norm(2,nres+j)
- dzj=dc_norm(3,nres+j)
- dscj_inv=vbld_inv(j+nres)
-
- chi1=chi(itypi,itypj)
- chi2=chi(itypj,itypi)
- chi12=chi1*chi2
- chip1=chip(itypi)
- chip2=chip(itypj)
- chip12=chip1*chip2
- alf1=alp(itypi)
- alf2=alp(itypj)
- alf12=0.5D0*(alf1+alf2)
-
- rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
- rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
-c The following are set in sc_angular
-c erij(1)=xj*rij
-c erij(2)=yj*rij
-c erij(3)=zj*rij
-c om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
-c om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
-c om12=dxi*dxj+dyi*dyj+dzi*dzj
- call sc_angular
- rij=1.0D0/rij ! Reset this so it makes sense
-
- sig0ij=sigma(itypi,itypj)
- sig=sig0ij*dsqrt(1.0D0/sigsq)
-
- ljXs=sig-sig0ij
- ljA=eps1*eps2rt**2*eps3rt**2
- ljB=ljA*bb(itypi,itypj)
- ljA=ljA*aa(itypi,itypj)
- ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-
- ssXs=d0cm
- deltat1=1.0d0-om1
- deltat2=1.0d0+om2
- deltat12=om2-om1+2.0d0
- cosphi=om12-om1*om2
- ssA=akcm
- ssB=akct*deltat12
- ssC=ss_depth
- & +akth*(deltat1*deltat1+deltat2*deltat2)
- & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
- ssxm=ssXs-0.5D0*ssB/ssA
-
-c-------TESTING CODE
-c$$$c Some extra output
-c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
-c$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
-c$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
-c$$$ if (ssx0.gt.0.0d0) then
-c$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
-c$$$ else
-c$$$ ssx0=ssxm
-c$$$ endif
-c$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-c$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
-c$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
-c$$$ return
-c-------END TESTING CODE
-
-c-------TESTING CODE
-c Stop and plot energy and derivative as a function of distance
- if (checkstop) then
- ssm=ssC-0.25D0*ssB*ssB/ssA
- ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
- if (ssm.lt.ljm .and.
- & dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
- nicheck=1000
- njcheck=1
- deps=0.5d-7
- else
- checkstop=.false.
- endif
- endif
- if (.not.checkstop) then
- nicheck=0
- njcheck=-1
- endif
-
- do icheck=0,nicheck
- do jcheck=-1,njcheck
- if (checkstop) rij=(ssxm-1.0d0)+
- & ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
-c-------END TESTING CODE
-
- if (rij.gt.ljxm) then
- havebond=.false.
- ljd=rij-ljXs
- fac=(1.0D0/ljd)**expon
- e1=fac*fac*aa(itypi,itypj)
- e2=fac*bb(itypi,itypj)
- eij=eps1*eps2rt*eps3rt*(e1+e2)
- eps2der=eij*eps3rt
- eps3der=eij*eps2rt
- eij=eij*eps2rt*eps3rt
-
- sigder=-sig/sigsq
- e1=e1*eps1*eps2rt**2*eps3rt**2
- ed=-expon*(e1+eij)/ljd
- sigder=ed*sigder
- eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
- eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
- eom12=eij*eps1_om12+eps2der*eps2rt_om12
- & -2.0D0*alf12*eps3der+sigder*sigsq_om12
- else if (rij.lt.ssxm) then
- havebond=.true.
- ssd=rij-ssXs
- eij=ssA*ssd*ssd+ssB*ssd+ssC
-
- ed=2*akcm*ssd+akct*deltat12
- pom1=akct*ssd
- pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
- eom1=-2*akth*deltat1-pom1-om2*pom2
- eom2= 2*akth*deltat2+pom1-om1*pom2
- eom12=pom2
- else
- omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
-
- d_ssxm(1)=0.5D0*akct/ssA
- d_ssxm(2)=-d_ssxm(1)
- d_ssxm(3)=0.0D0
-
- d_ljxm(1)=sig0ij/sqrt(sigsq**3)
- d_ljxm(2)=d_ljxm(1)*sigsq_om2
- d_ljxm(3)=d_ljxm(1)*sigsq_om12
- d_ljxm(1)=d_ljxm(1)*sigsq_om1
-
-c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
- xm=0.5d0*(ssxm+ljxm)
- do k=1,3
- d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
- enddo
- if (rij.lt.xm) then
- havebond=.true.
- ssm=ssC-0.25D0*ssB*ssB/ssA
- d_ssm(1)=0.5D0*akct*ssB/ssA
- d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
- d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
- d_ssm(3)=omega
- f1=(rij-xm)/(ssxm-xm)
- f2=(rij-ssxm)/(xm-ssxm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=ssm*h1+Ht*h2
- delta_inv=1.0d0/(xm-ssxm)
- deltasq_inv=delta_inv*delta_inv
- fac=ssm*hd1-Ht*hd2
- fac1=deltasq_inv*fac*(xm-rij)
- fac2=deltasq_inv*fac*(rij-ssxm)
- ed=delta_inv*(Ht*hd2-ssm*hd1)
- eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
- eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
- eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
- else
- havebond=.false.
- ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
- d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB
- d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
- d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt-
- + alf12/eps3rt)
- d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
- f1=(rij-ljxm)/(xm-ljxm)
- f2=(rij-xm)/(ljxm-xm)
- h1=h_base(f1,hd1)
- h2=h_base(f2,hd2)
- eij=Ht*h1+ljm*h2
- delta_inv=1.0d0/(ljxm-xm)
- deltasq_inv=delta_inv*delta_inv
- fac=Ht*hd1-ljm*hd2
- fac1=deltasq_inv*fac*(ljxm-rij)
- fac2=deltasq_inv*fac*(rij-xm)
- ed=delta_inv*(ljm*hd2-Ht*hd1)
- eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
- eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
- eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
- endif
-c-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
-
-c-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
-c$$$ ssd=rij-ssXs
-c$$$ ljd=rij-ljXs
-c$$$ fac1=rij-ljxm
-c$$$ fac2=rij-ssxm
-c$$$
-c$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
-c$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
-c$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
-c$$$
-c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
-c$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
-c$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
-c$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
-c$$$ d_ssm(3)=omega
-c$$$
-c$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
-c$$$ do k=1,3
-c$$$ d_ljm(k)=ljm*d_ljB(k)
-c$$$ enddo
-c$$$ ljm=ljm*ljB
-c$$$
-c$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
-c$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
-c$$$ d_ss(2)=akct*ssd
-c$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
-c$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
-c$$$ d_ss(3)=omega
-c$$$
-c$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
-c$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
-c$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
-c$$$ do k=1,3
-c$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
-c$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
-c$$$ enddo
-c$$$ ljf=ljm+ljf*ljB*fac1*fac1
-c$$$
-c$$$ f1=(rij-ljxm)/(ssxm-ljxm)
-c$$$ f2=(rij-ssxm)/(ljxm-ssxm)
-c$$$ h1=h_base(f1,hd1)
-c$$$ h2=h_base(f2,hd2)
-c$$$ eij=ss*h1+ljf*h2
-c$$$ delta_inv=1.0d0/(ljxm-ssxm)
-c$$$ deltasq_inv=delta_inv*delta_inv
-c$$$ fac=ljf*hd2-ss*hd1
-c$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
-c$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
-c$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
-c$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
-c$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
-c$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
-c$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
-c$$$
-c$$$ havebond=.false.
-c$$$ if (ed.gt.0.0d0) havebond=.true.
-c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
-
- endif
-
- if (havebond) then
-#ifndef CLUST
-#ifndef WHAM
-c if (dyn_ssbond_ij(i,j).eq.1.0d300) then
-c write(iout,'(a15,f12.2,f8.1,2i5)')
-c & "SSBOND_E_FORM",totT,t_bath,i,j
-c endif
-#endif
-#endif
- dyn_ssbond_ij(i,j)=eij
- else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
- dyn_ssbond_ij(i,j)=1.0d300
-#ifndef CLUST
-#ifndef WHAM
-c write(iout,'(a15,f12.2,f8.1,2i5)')
-c & "SSBOND_E_BREAK",totT,t_bath,i,j
-#endif
-#endif
- endif
-
-c-------TESTING CODE
- if (checkstop) then
- if (jcheck.eq.0) write(iout,'(a,3f15.8,$)')
- & "CHECKSTOP",rij,eij,ed
- echeck(jcheck)=eij
- endif
- enddo
- if (checkstop) then
- write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
- endif
- enddo
- if (checkstop) then
- transgrad=.true.
- checkstop=.false.
- endif
-c-------END TESTING CODE
-
- do k=1,3
- dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
- dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
- enddo
- do k=1,3
- gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
- enddo
- do k=1,3
- gvdwx(k,i)=gvdwx(k,i)-gg(k)
- & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
- & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
- gvdwx(k,j)=gvdwx(k,j)+gg(k)
- & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
- & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
- enddo
-cgrad do k=i,j-1
-cgrad do l=1,3
-cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
-cgrad enddo
-cgrad enddo
-
- do l=1,3
- gvdwc(l,i)=gvdwc(l,i)-gg(l)
- gvdwc(l,j)=gvdwc(l,j)+gg(l)
- enddo
-
- return
- end
-
-C-----------------------------------------------------------------------------
-
- double precision function h_base(x,deriv)
-c A smooth function going 0->1 in range [0,1]
-c It should NOT be called outside range [0,1], it will not work there.
- implicit none
-
-c Input arguments
- double precision x
-
-c Output arguments
- double precision deriv
-
-c Local variables
- double precision xsq
-
-
-c Two parabolas put together. First derivative zero at extrema
-c$$$ if (x.lt.0.5D0) then
-c$$$ h_base=2.0D0*x*x
-c$$$ deriv=4.0D0*x
-c$$$ else
-c$$$ deriv=1.0D0-x
-c$$$ h_base=1.0D0-2.0D0*deriv*deriv
-c$$$ deriv=4.0D0*deriv
-c$$$ endif
-
-c Third degree polynomial. First derivative zero at extrema
- h_base=x*x*(3.0d0-2.0d0*x)
- deriv=6.0d0*x*(1.0d0-x)
-
-c Fifth degree polynomial. First and second derivatives zero at extrema
-c$$$ xsq=x*x
-c$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
-c$$$ deriv=x-1.0d0
-c$$$ deriv=deriv*deriv
-c$$$ deriv=30.0d0*xsq*deriv
-
- return
- end
-
-c----------------------------------------------------------------------------
-
- subroutine dyn_set_nss
-c Adjust nss and other relevant variables based on dyn_ssbond_ij
-c implicit none
-
-c Includes
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.SBRIDGE'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.SETUP'
-#ifndef CLUST
-#ifndef WHAM
- include 'COMMON.MD'
-#endif
-#endif
-
-c Local variables
- double precision emin
- integer i,j,imin
- integer diff,allflag(maxdim),allnss,
- & allihpb(maxdim),alljhpb(maxdim),
- & newnss,newihpb(maxdim),newjhpb(maxdim)
- logical found
- integer i_newnss(max_fg_procs),displ(max_fg_procs)
- integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss
-
- allnss=0
- do i=1,nres-1
- do j=i+1,nres
- if (dyn_ssbond_ij(i,j).lt.1.0d300) then
- allnss=allnss+1
- allflag(allnss)=0
- allihpb(allnss)=i
- alljhpb(allnss)=j
- endif
- enddo
- enddo
-
-cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
-
- 1 emin=1.0d300
- do i=1,allnss
- if (allflag(i).eq.0 .and.
- & dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
- emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
- imin=i
- endif
- enddo
- if (emin.lt.1.0d300) then
- allflag(imin)=1
- do i=1,allnss
- if (allflag(i).eq.0 .and.
- & (allihpb(i).eq.allihpb(imin) .or.
- & alljhpb(i).eq.allihpb(imin) .or.
- & allihpb(i).eq.alljhpb(imin) .or.
- & alljhpb(i).eq.alljhpb(imin))) then
- allflag(i)=-1
- endif
- enddo
- goto 1
- endif
-
-cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
-
- newnss=0
- do i=1,allnss
- if (allflag(i).eq.1) then
- newnss=newnss+1
- newihpb(newnss)=allihpb(i)
- newjhpb(newnss)=alljhpb(i)
- endif
- enddo
-
-#ifdef MPI
- if (nfgtasks.gt.1)then
-
- call MPI_Reduce(newnss,g_newnss,1,
- & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
- call MPI_Gather(newnss,1,MPI_INTEGER,
- & i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
- displ(0)=0
- do i=1,nfgtasks-1,1
- displ(i)=i_newnss(i-1)+displ(i-1)
- enddo
- call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,
- & g_newihpb,i_newnss,displ,MPI_INTEGER,
- & king,FG_COMM,IERR)
- call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,
- & g_newjhpb,i_newnss,displ,MPI_INTEGER,
- & king,FG_COMM,IERR)
- if(fg_rank.eq.0) then
-c print *,'g_newnss',g_newnss
-c print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
-c print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
- newnss=g_newnss
- do i=1,newnss
- newihpb(i)=g_newihpb(i)
- newjhpb(i)=g_newjhpb(i)
- enddo
- endif
- endif
-#endif
-
- diff=newnss-nss
-
-cmc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
-
- do i=1,nss
- found=.false.
- do j=1,newnss
- if (idssb(i).eq.newihpb(j) .and.
- & jdssb(i).eq.newjhpb(j)) found=.true.
- enddo
-#ifndef CLUST
-#ifndef WHAM
- if (.not.found.and.fg_rank.eq.0)
- & write(iout,'(a15,f12.2,f8.1,2i5)')
- & "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
-#endif
-#endif
- enddo
-
- do i=1,newnss
- found=.false.
- do j=1,nss
- if (newihpb(i).eq.idssb(j) .and.
- & newjhpb(i).eq.jdssb(j)) found=.true.
- enddo
-#ifndef CLUST
-#ifndef WHAM
- if (.not.found.and.fg_rank.eq.0)
- & write(iout,'(a15,f12.2,f8.1,2i5)')
- & "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
-#endif
-#endif
- enddo
-
- nss=newnss
- do i=1,nss
- idssb(i)=newihpb(i)
- jdssb(i)=newjhpb(i)
- enddo
-
- return
- end
-
-c----------------------------------------------------------------------------
-
-#ifdef WHAM
- subroutine read_ssHist
- implicit none
-
-c Includes
- include 'DIMENSIONS'
- include "DIMENSIONS.FREE"
- include 'COMMON.FREE'
-
-c Local variables
- integer i,j
- character*80 controlcard
-
- do i=1,dyn_nssHist
- call card_concat(controlcard,.true.)
- read(controlcard,*)
- & dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
- enddo
-
- return
- end
-#endif
-
-c----------------------------------------------------------------------------
-
-
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-C-----------------------------------------------------------------------------
-
-c$$$c-----------------------------------------------------------------------------
-c$$$
-c$$$ subroutine ss_relax(i_in,j_in)
-c$$$ implicit none
-c$$$
-c$$$c Includes
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.CHAIN'
-c$$$ include 'COMMON.IOUNITS'
-c$$$ include 'COMMON.INTERACT'
-c$$$
-c$$$c Input arguments
-c$$$ integer i_in,j_in
-c$$$
-c$$$c Local variables
-c$$$ integer i,iretcode,nfun_sc
-c$$$ logical scfail
-c$$$ double precision var(maxvar),e_sc,etot
-c$$$
-c$$$
-c$$$ mask_r=.true.
-c$$$ do i=nnt,nct
-c$$$ mask_side(i)=0
-c$$$ enddo
-c$$$ mask_side(i_in)=1
-c$$$ mask_side(j_in)=1
-c$$$
-c$$$c Minimize the two selected side-chains
-c$$$ call overlap_sc(scfail) ! Better not fail!
-c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc)
-c$$$
-c$$$ mask_r=.false.
-c$$$
-c$$$ return
-c$$$ end
-c$$$
-c$$$c-------------------------------------------------------------
-c$$$
-c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun)
-c$$$c Minimize side-chains only, starting from geom but without modifying
-c$$$c bond lengths.
-c$$$c If mask_r is already set, only the selected side-chains are minimized,
-c$$$c otherwise all side-chains are minimized keeping the backbone frozen.
-c$$$ implicit none
-c$$$
-c$$$c Includes
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.IOUNITS'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.CHAIN'
-c$$$ include 'COMMON.GEO'
-c$$$ include 'COMMON.MINIM'
-c$$$ integer icall
-c$$$ common /srutu/ icall
-c$$$
-c$$$c Output arguments
-c$$$ double precision etot_sc
-c$$$ integer iretcode,nfun
-c$$$
-c$$$c External functions/subroutines
-c$$$ external func_sc,grad_sc,fdum
-c$$$
-c$$$c Local variables
-c$$$ integer liv,lv
-c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2))
-c$$$ integer iv(liv)
-c$$$ double precision rdum(1)
-c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar)
-c$$$ integer idum(1)
-c$$$ integer i,nvar_restr
-c$$$
-c$$$
-c$$$cmc start_minim=.true.
-c$$$ call deflt(2,iv,liv,lv,v)
-c$$$* 12 means fresh start, dont call deflt
-c$$$ iv(1)=12
-c$$$* max num of fun calls
-c$$$ if (maxfun.eq.0) maxfun=500
-c$$$ iv(17)=maxfun
-c$$$* max num of iterations
-c$$$ if (maxmin.eq.0) maxmin=1000
-c$$$ iv(18)=maxmin
-c$$$* controls output
-c$$$ iv(19)=1
-c$$$* selects output unit
-c$$$ iv(21)=0
-c$$$c iv(21)=iout ! DEBUG
-c$$$c iv(21)=8 ! DEBUG
-c$$$* 1 means to print out result
-c$$$ iv(22)=0
-c$$$c iv(22)=1 ! DEBUG
-c$$$* 1 means to print out summary stats
-c$$$ iv(23)=0
-c$$$c iv(23)=1 ! DEBUG
-c$$$* 1 means to print initial x and d
-c$$$ iv(24)=0
-c$$$c iv(24)=1 ! DEBUG
-c$$$* min val for v(radfac) default is 0.1
-c$$$ v(24)=0.1D0
-c$$$* max val for v(radfac) default is 4.0
-c$$$ v(25)=2.0D0
-c$$$c v(25)=4.0D0
-c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
-c$$$* the sumsl default is 0.1
-c$$$ v(26)=0.1D0
-c$$$* false conv if (act fnctn decrease) .lt. v(34)
-c$$$* the sumsl default is 100*machep
-c$$$ v(34)=v(34)/100.0D0
-c$$$* absolute convergence
-c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4
-c$$$ v(31)=tolf
-c$$$* relative convergence
-c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1
-c$$$ v(32)=rtolf
-c$$$* controls initial step size
-c$$$ v(35)=1.0D-1
-c$$$* large vals of d correspond to small components of step
-c$$$ do i=1,nphi
-c$$$ d(i)=1.0D-1
-c$$$ enddo
-c$$$ do i=nphi+1,nvar
-c$$$ d(i)=1.0D-1
-c$$$ enddo
-c$$$
-c$$$ call geom_to_var(nvar,x)
-c$$$ IF (mask_r) THEN
-c$$$ do i=1,nres ! Just in case...
-c$$$ mask_phi(i)=0
-c$$$ mask_theta(i)=0
-c$$$ enddo
-c$$$ call x2xx(x,xx,nvar_restr)
-c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
-c$$$ & iv,liv,lv,v,idum,rdum,fdum)
-c$$$ call xx2x(x,xx)
-c$$$ ELSE
-c$$$c When minimizing ALL side-chains, etotal_sc is a little
-c$$$c faster if we don't set mask_r
-c$$$ do i=1,nres
-c$$$ mask_phi(i)=0
-c$$$ mask_theta(i)=0
-c$$$ mask_side(i)=1
-c$$$ enddo
-c$$$ call x2xx(x,xx,nvar_restr)
-c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc,
-c$$$ & iv,liv,lv,v,idum,rdum,fdum)
-c$$$ call xx2x(x,xx)
-c$$$ ENDIF
-c$$$ call var_to_geom(nvar,x)
-c$$$ call chainbuild_sc
-c$$$ etot_sc=v(10)
-c$$$ iretcode=iv(1)
-c$$$ nfun=iv(6)
-c$$$ return
-c$$$ end
-c$$$
-c$$$C--------------------------------------------------------------------------
-c$$$
-c$$$ subroutine chainbuild_sc
-c$$$ implicit none
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.INTERACT'
-c$$$
-c$$$c Local variables
-c$$$ integer i
-c$$$
-c$$$
-c$$$ do i=nnt,nct
-c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then
-c$$$ call locate_side_chain(i)
-c$$$ endif
-c$$$ enddo
-c$$$
-c$$$ return
-c$$$ end
-c$$$
-c$$$C--------------------------------------------------------------------------
-c$$$
-c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm)
-c$$$ implicit none
-c$$$
-c$$$c Includes
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.DERIV'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.MINIM'
-c$$$ include 'COMMON.IOUNITS'
-c$$$
-c$$$c Input arguments
-c$$$ integer n
-c$$$ double precision x(maxvar)
-c$$$ double precision ufparm
-c$$$ external ufparm
-c$$$
-c$$$c Input/Output arguments
-c$$$ integer nf
-c$$$ integer uiparm(1)
-c$$$ double precision urparm(1)
-c$$$
-c$$$c Output arguments
-c$$$ double precision f
-c$$$
-c$$$c Local variables
-c$$$ double precision energia(0:n_ene)
-c$$$#ifdef OSF
-c$$$c Variables used to intercept NaNs
-c$$$ double precision x_sum
-c$$$ integer i_NAN
-c$$$#endif
-c$$$
-c$$$
-c$$$ nfl=nf
-c$$$ icg=mod(nf,2)+1
-c$$$
-c$$$#ifdef OSF
-c$$$c Intercept NaNs in the coordinates, before calling etotal_sc
-c$$$ x_sum=0.D0
-c$$$ do i_NAN=1,n
-c$$$ x_sum=x_sum+x(i_NAN)
-c$$$ enddo
-c$$$c Calculate the energy only if the coordinates are ok
-c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then
-c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates"
-c$$$ f=1.0D+77
-c$$$ nf=0
-c$$$ else
-c$$$#endif
-c$$$
-c$$$ call var_to_geom_restr(n,x)
-c$$$ call zerograd
-c$$$ call chainbuild_sc
-c$$$ call etotal_sc(energia(0))
-c$$$ f=energia(0)
-c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0
-c$$$
-c$$$#ifdef OSF
-c$$$ endif
-c$$$#endif
-c$$$
-c$$$ return
-c$$$ end
-c$$$
-c$$$c-------------------------------------------------------
-c$$$
-c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm)
-c$$$ implicit none
-c$$$
-c$$$c Includes
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.CHAIN'
-c$$$ include 'COMMON.DERIV'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.INTERACT'
-c$$$ include 'COMMON.MINIM'
-c$$$
-c$$$c Input arguments
-c$$$ integer n
-c$$$ double precision x(maxvar)
-c$$$ double precision ufparm
-c$$$ external ufparm
-c$$$
-c$$$c Input/Output arguments
-c$$$ integer nf
-c$$$ integer uiparm(1)
-c$$$ double precision urparm(1)
-c$$$
-c$$$c Output arguments
-c$$$ double precision g(maxvar)
-c$$$
-c$$$c Local variables
-c$$$ double precision f,gphii,gthetai,galphai,gomegai
-c$$$ integer ig,ind,i,j,k,igall,ij
-c$$$
-c$$$
-c$$$ icg=mod(nf,2)+1
-c$$$ if (nf-nfl+1) 20,30,40
-c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm)
-c$$$c write (iout,*) 'grad 20'
-c$$$ if (nf.eq.0) return
-c$$$ goto 40
-c$$$ 30 call var_to_geom_restr(n,x)
-c$$$ call chainbuild_sc
-c$$$C
-c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-c$$$C
-c$$$ 40 call cartder
-c$$$C
-c$$$C Convert the Cartesian gradient into internal-coordinate gradient.
-c$$$C
-c$$$
-c$$$ ig=0
-c$$$ ind=nres-2
-c$$$ do i=2,nres-2
-c$$$ IF (mask_phi(i+2).eq.1) THEN
-c$$$ gphii=0.0D0
-c$$$ do j=i+1,nres-1
-c$$$ ind=ind+1
-c$$$ do k=1,3
-c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
-c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
-c$$$ enddo
-c$$$ enddo
-c$$$ ig=ig+1
-c$$$ g(ig)=gphii
-c$$$ ELSE
-c$$$ ind=ind+nres-1-i
-c$$$ ENDIF
-c$$$ enddo
-c$$$
-c$$$
-c$$$ ind=0
-c$$$ do i=1,nres-2
-c$$$ IF (mask_theta(i+2).eq.1) THEN
-c$$$ ig=ig+1
-c$$$ gthetai=0.0D0
-c$$$ do j=i+1,nres-1
-c$$$ ind=ind+1
-c$$$ do k=1,3
-c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
-c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
-c$$$ enddo
-c$$$ enddo
-c$$$ g(ig)=gthetai
-c$$$ ELSE
-c$$$ ind=ind+nres-1-i
-c$$$ ENDIF
-c$$$ enddo
-c$$$
-c$$$ do i=2,nres-1
-c$$$ if (itype(i).ne.10) then
-c$$$ IF (mask_side(i).eq.1) THEN
-c$$$ ig=ig+1
-c$$$ galphai=0.0D0
-c$$$ do k=1,3
-c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg)
-c$$$ enddo
-c$$$ g(ig)=galphai
-c$$$ ENDIF
-c$$$ endif
-c$$$ enddo
-c$$$
-c$$$
-c$$$ do i=2,nres-1
-c$$$ if (itype(i).ne.10) then
-c$$$ IF (mask_side(i).eq.1) THEN
-c$$$ ig=ig+1
-c$$$ gomegai=0.0D0
-c$$$ do k=1,3
-c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
-c$$$ enddo
-c$$$ g(ig)=gomegai
-c$$$ ENDIF
-c$$$ endif
-c$$$ enddo
-c$$$
-c$$$C
-c$$$C Add the components corresponding to local energy terms.
-c$$$C
-c$$$
-c$$$ ig=0
-c$$$ igall=0
-c$$$ do i=4,nres
-c$$$ igall=igall+1
-c$$$ if (mask_phi(i).eq.1) then
-c$$$ ig=ig+1
-c$$$ g(ig)=g(ig)+gloc(igall,icg)
-c$$$ endif
-c$$$ enddo
-c$$$
-c$$$ do i=3,nres
-c$$$ igall=igall+1
-c$$$ if (mask_theta(i).eq.1) then
-c$$$ ig=ig+1
-c$$$ g(ig)=g(ig)+gloc(igall,icg)
-c$$$ endif
-c$$$ enddo
-c$$$
-c$$$ do ij=1,2
-c$$$ do i=2,nres-1
-c$$$ if (itype(i).ne.10) then
-c$$$ igall=igall+1
-c$$$ if (mask_side(i).eq.1) then
-c$$$ ig=ig+1
-c$$$ g(ig)=g(ig)+gloc(igall,icg)
-c$$$ endif
-c$$$ endif
-c$$$ enddo
-c$$$ enddo
-c$$$
-c$$$cd do i=1,ig
-c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i)
-c$$$cd enddo
-c$$$
-c$$$ return
-c$$$ end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$ subroutine etotal_sc(energy_sc)
-c$$$ implicit none
-c$$$
-c$$$c Includes
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.INTERACT'
-c$$$ include 'COMMON.DERIV'
-c$$$ include 'COMMON.FFIELD'
-c$$$
-c$$$c Output arguments
-c$$$ double precision energy_sc(0:n_ene)
-c$$$
-c$$$c Local variables
-c$$$ double precision evdw,escloc
-c$$$ integer i,j
-c$$$
-c$$$
-c$$$ do i=1,n_ene
-c$$$ energy_sc(i)=0.0D0
-c$$$ enddo
-c$$$
-c$$$ if (mask_r) then
-c$$$ call egb_sc(evdw)
-c$$$ call esc_sc(escloc)
-c$$$ else
-c$$$ call egb(evdw)
-c$$$ call esc(escloc)
-c$$$ endif
-c$$$
-c$$$ if (evdw.eq.1.0D20) then
-c$$$ energy_sc(0)=evdw
-c$$$ else
-c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc
-c$$$ endif
-c$$$ energy_sc(1)=evdw
-c$$$ energy_sc(12)=escloc
-c$$$
-c$$$C
-c$$$C Sum up the components of the Cartesian gradient.
-c$$$C
-c$$$ do i=1,nct
-c$$$ do j=1,3
-c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i)
-c$$$ enddo
-c$$$ enddo
-c$$$
-c$$$ return
-c$$$ end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$ subroutine egb_sc(evdw)
-c$$$C
-c$$$C This subroutine calculates the interaction energy of nonbonded side chains
-c$$$C assuming the Gay-Berne potential of interaction.
-c$$$C
-c$$$ implicit real*8 (a-h,o-z)
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.GEO'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.LOCAL'
-c$$$ include 'COMMON.CHAIN'
-c$$$ include 'COMMON.DERIV'
-c$$$ include 'COMMON.NAMES'
-c$$$ include 'COMMON.INTERACT'
-c$$$ include 'COMMON.IOUNITS'
-c$$$ include 'COMMON.CALC'
-c$$$ include 'COMMON.CONTROL'
-c$$$ logical lprn
-c$$$ evdw=0.0D0
-c$$$ energy_dec=.false.
-c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-c$$$ evdw=0.0D0
-c$$$ lprn=.false.
-c$$$c if (icall.eq.0) lprn=.false.
-c$$$ ind=0
-c$$$ do i=iatsc_s,iatsc_e
-c$$$ itypi=itype(i)
-c$$$ itypi1=itype(i+1)
-c$$$ xi=c(1,nres+i)
-c$$$ yi=c(2,nres+i)
-c$$$ zi=c(3,nres+i)
-c$$$ dxi=dc_norm(1,nres+i)
-c$$$ dyi=dc_norm(2,nres+i)
-c$$$ dzi=dc_norm(3,nres+i)
-c$$$c dsci_inv=dsc_inv(itypi)
-c$$$ dsci_inv=vbld_inv(i+nres)
-c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$C
-c$$$C Calculate SC interaction energy.
-c$$$C
-c$$$ do iint=1,nint_gr(i)
-c$$$ do j=istart(i,iint),iend(i,iint)
-c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN
-c$$$ ind=ind+1
-c$$$ itypj=itype(j)
-c$$$c dscj_inv=dsc_inv(itypj)
-c$$$ dscj_inv=vbld_inv(j+nres)
-c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c$$$c & 1.0d0/vbld(j+nres)
-c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
-c$$$ sig0ij=sigma(itypi,itypj)
-c$$$ chi1=chi(itypi,itypj)
-c$$$ chi2=chi(itypj,itypi)
-c$$$ chi12=chi1*chi2
-c$$$ chip1=chip(itypi)
-c$$$ chip2=chip(itypj)
-c$$$ chip12=chip1*chip2
-c$$$ alf1=alp(itypi)
-c$$$ alf2=alp(itypj)
-c$$$ alf12=0.5D0*(alf1+alf2)
-c$$$C For diagnostics only!!!
-c$$$c chi1=0.0D0
-c$$$c chi2=0.0D0
-c$$$c chi12=0.0D0
-c$$$c chip1=0.0D0
-c$$$c chip2=0.0D0
-c$$$c chip12=0.0D0
-c$$$c alf1=0.0D0
-c$$$c alf2=0.0D0
-c$$$c alf12=0.0D0
-c$$$ xj=c(1,nres+j)-xi
-c$$$ yj=c(2,nres+j)-yi
-c$$$ zj=c(3,nres+j)-zi
-c$$$ dxj=dc_norm(1,nres+j)
-c$$$ dyj=dc_norm(2,nres+j)
-c$$$ dzj=dc_norm(3,nres+j)
-c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$c write (iout,*) "j",j," dc_norm",
-c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
-c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-c$$$ rij=dsqrt(rrij)
-c$$$C Calculate angle-dependent terms of energy and contributions to their
-c$$$C derivatives.
-c$$$ call sc_angular
-c$$$ sigsq=1.0D0/sigsq
-c$$$ sig=sig0ij*dsqrt(sigsq)
-c$$$ rij_shift=1.0D0/rij-sig+sig0ij
-c$$$c for diagnostics; uncomment
-c$$$c rij_shift=1.2*sig0ij
-c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
-c$$$ if (rij_shift.le.0.0D0) then
-c$$$ evdw=1.0D20
-c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$cd & restyp(itypi),i,restyp(itypj),j,
-c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
-c$$$ return
-c$$$ endif
-c$$$ sigder=-sig*sigsq
-c$$$c---------------------------------------------------------------
-c$$$ rij_shift=1.0D0/rij_shift
-c$$$ fac=rij_shift**expon
-c$$$ e1=fac*fac*aa(itypi,itypj)
-c$$$ e2=fac*bb(itypi,itypj)
-c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
-c$$$ eps2der=evdwij*eps3rt
-c$$$ eps3der=evdwij*eps2rt
-c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
-c$$$ evdwij=evdwij*eps2rt*eps3rt
-c$$$ evdw=evdw+evdwij
-c$$$ if (lprn) then
-c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$ & restyp(itypi),i,restyp(itypj),j,
-c$$$ & epsi,sigm,chi1,chi2,chip1,chip2,
-c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
-c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-c$$$ & evdwij
-c$$$ endif
-c$$$
-c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)')
-c$$$ & 'evdw',i,j,evdwij
-c$$$
-c$$$C Calculate gradient components.
-c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2
-c$$$ fac=-expon*(e1+evdwij)*rij_shift
-c$$$ sigder=fac*sigder
-c$$$ fac=rij*fac
-c$$$c fac=0.0d0
-c$$$C Calculate the radial part of the gradient
-c$$$ gg(1)=xj*fac
-c$$$ gg(2)=yj*fac
-c$$$ gg(3)=zj*fac
-c$$$C Calculate angular part of the gradient.
-c$$$ call sc_grad
-c$$$ ENDIF
-c$$$ enddo ! j
-c$$$ enddo ! iint
-c$$$ enddo ! i
-c$$$ energy_dec=.false.
-c$$$ return
-c$$$ end
-c$$$
-c$$$c-----------------------------------------------------------------------------
-c$$$
-c$$$ subroutine esc_sc(escloc)
-c$$$C Calculate the local energy of a side chain and its derivatives in the
-c$$$C corresponding virtual-bond valence angles THETA and the spherical angles
-c$$$C ALPHA and OMEGA.
-c$$$ implicit real*8 (a-h,o-z)
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.GEO'
-c$$$ include 'COMMON.LOCAL'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.INTERACT'
-c$$$ include 'COMMON.DERIV'
-c$$$ include 'COMMON.CHAIN'
-c$$$ include 'COMMON.IOUNITS'
-c$$$ include 'COMMON.NAMES'
-c$$$ include 'COMMON.FFIELD'
-c$$$ include 'COMMON.CONTROL'
-c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
-c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3)
-c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit
-c$$$ delta=0.02d0*pi
-c$$$ escloc=0.0D0
-c$$$c write (iout,'(a)') 'ESC'
-c$$$ do i=loc_start,loc_end
-c$$$ IF (mask_side(i).eq.1) THEN
-c$$$ it=itype(i)
-c$$$ if (it.eq.10) goto 1
-c$$$ nlobit=nlob(it)
-c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit
-c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
-c$$$ theti=theta(i+1)-pipol
-c$$$ x(1)=dtan(theti)
-c$$$ x(2)=alph(i)
-c$$$ x(3)=omeg(i)
-c$$$
-c$$$ if (x(2).gt.pi-delta) then
-c$$$ xtemp(1)=x(1)
-c$$$ xtemp(2)=pi-delta
-c$$$ xtemp(3)=x(3)
-c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
-c$$$ xtemp(2)=pi
-c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
-c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
-c$$$ & escloci,dersc(2))
-c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
-c$$$ & ddersc0(1),dersc(1))
-c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
-c$$$ & ddersc0(3),dersc(3))
-c$$$ xtemp(2)=pi-delta
-c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
-c$$$ xtemp(2)=pi
-c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
-c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
-c$$$ & dersc0(2),esclocbi,dersc02)
-c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
-c$$$ & dersc12,dersc01)
-c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd)
-c$$$ dersc0(1)=dersc01
-c$$$ dersc0(2)=dersc02
-c$$$ dersc0(3)=0.0d0
-c$$$ do k=1,3
-c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
-c$$$ enddo
-c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c$$$c & esclocbi,ss,ssd
-c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c$$$c escloci=esclocbi
-c$$$c write (iout,*) escloci
-c$$$ else if (x(2).lt.delta) then
-c$$$ xtemp(1)=x(1)
-c$$$ xtemp(2)=delta
-c$$$ xtemp(3)=x(3)
-c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
-c$$$ xtemp(2)=0.0d0
-c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
-c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
-c$$$ & escloci,dersc(2))
-c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
-c$$$ & ddersc0(1),dersc(1))
-c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
-c$$$ & ddersc0(3),dersc(3))
-c$$$ xtemp(2)=delta
-c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
-c$$$ xtemp(2)=0.0d0
-c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
-c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
-c$$$ & dersc0(2),esclocbi,dersc02)
-c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
-c$$$ & dersc12,dersc01)
-c$$$ dersc0(1)=dersc01
-c$$$ dersc0(2)=dersc02
-c$$$ dersc0(3)=0.0d0
-c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd)
-c$$$ do k=1,3
-c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
-c$$$ enddo
-c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
-c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
-c$$$c & esclocbi,ss,ssd
-c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi
-c$$$c write (iout,*) escloci
-c$$$ else
-c$$$ call enesc(x,escloci,dersc,ddummy,.false.)
-c$$$ endif
-c$$$
-c$$$ escloc=escloc+escloci
-c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)')
-c$$$ & 'escloc',i,escloci
-c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
-c$$$
-c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
-c$$$ & wscloc*dersc(1)
-c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2)
-c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
-c$$$ 1 continue
-c$$$ ENDIF
-c$$$ enddo
-c$$$ return
-c$$$ end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$ subroutine egb_ij(i_sc,j_sc,evdw)
-c$$$C
-c$$$C This subroutine calculates the interaction energy of nonbonded side chains
-c$$$C assuming the Gay-Berne potential of interaction.
-c$$$C
-c$$$ implicit real*8 (a-h,o-z)
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.GEO'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.LOCAL'
-c$$$ include 'COMMON.CHAIN'
-c$$$ include 'COMMON.DERIV'
-c$$$ include 'COMMON.NAMES'
-c$$$ include 'COMMON.INTERACT'
-c$$$ include 'COMMON.IOUNITS'
-c$$$ include 'COMMON.CALC'
-c$$$ include 'COMMON.CONTROL'
-c$$$ logical lprn
-c$$$ evdw=0.0D0
-c$$$ energy_dec=.false.
-c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
-c$$$ evdw=0.0D0
-c$$$ lprn=.false.
-c$$$ ind=0
-c$$$c$$$ do i=iatsc_s,iatsc_e
-c$$$ i=i_sc
-c$$$ itypi=itype(i)
-c$$$ itypi1=itype(i+1)
-c$$$ xi=c(1,nres+i)
-c$$$ yi=c(2,nres+i)
-c$$$ zi=c(3,nres+i)
-c$$$ dxi=dc_norm(1,nres+i)
-c$$$ dyi=dc_norm(2,nres+i)
-c$$$ dzi=dc_norm(3,nres+i)
-c$$$c dsci_inv=dsc_inv(itypi)
-c$$$ dsci_inv=vbld_inv(i+nres)
-c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
-c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$C
-c$$$C Calculate SC interaction energy.
-c$$$C
-c$$$c$$$ do iint=1,nint_gr(i)
-c$$$c$$$ do j=istart(i,iint),iend(i,iint)
-c$$$ j=j_sc
-c$$$ ind=ind+1
-c$$$ itypj=itype(j)
-c$$$c dscj_inv=dsc_inv(itypj)
-c$$$ dscj_inv=vbld_inv(j+nres)
-c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
-c$$$c & 1.0d0/vbld(j+nres)
-c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
-c$$$ sig0ij=sigma(itypi,itypj)
-c$$$ chi1=chi(itypi,itypj)
-c$$$ chi2=chi(itypj,itypi)
-c$$$ chi12=chi1*chi2
-c$$$ chip1=chip(itypi)
-c$$$ chip2=chip(itypj)
-c$$$ chip12=chip1*chip2
-c$$$ alf1=alp(itypi)
-c$$$ alf2=alp(itypj)
-c$$$ alf12=0.5D0*(alf1+alf2)
-c$$$C For diagnostics only!!!
-c$$$c chi1=0.0D0
-c$$$c chi2=0.0D0
-c$$$c chi12=0.0D0
-c$$$c chip1=0.0D0
-c$$$c chip2=0.0D0
-c$$$c chip12=0.0D0
-c$$$c alf1=0.0D0
-c$$$c alf2=0.0D0
-c$$$c alf12=0.0D0
-c$$$ xj=c(1,nres+j)-xi
-c$$$ yj=c(2,nres+j)-yi
-c$$$ zj=c(3,nres+j)-zi
-c$$$ dxj=dc_norm(1,nres+j)
-c$$$ dyj=dc_norm(2,nres+j)
-c$$$ dzj=dc_norm(3,nres+j)
-c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
-c$$$c write (iout,*) "j",j," dc_norm",
-c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
-c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
-c$$$ rij=dsqrt(rrij)
-c$$$C Calculate angle-dependent terms of energy and contributions to their
-c$$$C derivatives.
-c$$$ call sc_angular
-c$$$ sigsq=1.0D0/sigsq
-c$$$ sig=sig0ij*dsqrt(sigsq)
-c$$$ rij_shift=1.0D0/rij-sig+sig0ij
-c$$$c for diagnostics; uncomment
-c$$$c rij_shift=1.2*sig0ij
-c$$$C I hate to put IF's in the loops, but here don't have another choice!!!!
-c$$$ if (rij_shift.le.0.0D0) then
-c$$$ evdw=1.0D20
-c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$cd & restyp(itypi),i,restyp(itypj),j,
-c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
-c$$$ return
-c$$$ endif
-c$$$ sigder=-sig*sigsq
-c$$$c---------------------------------------------------------------
-c$$$ rij_shift=1.0D0/rij_shift
-c$$$ fac=rij_shift**expon
-c$$$ e1=fac*fac*aa(itypi,itypj)
-c$$$ e2=fac*bb(itypi,itypj)
-c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2)
-c$$$ eps2der=evdwij*eps3rt
-c$$$ eps3der=evdwij*eps2rt
-c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
-c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
-c$$$ evdwij=evdwij*eps2rt*eps3rt
-c$$$ evdw=evdw+evdwij
-c$$$ if (lprn) then
-c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
-c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
-c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))')
-c$$$ & restyp(itypi),i,restyp(itypj),j,
-c$$$ & epsi,sigm,chi1,chi2,chip1,chip2,
-c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
-c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
-c$$$ & evdwij
-c$$$ endif
-c$$$
-c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)')
-c$$$ & 'evdw',i,j,evdwij
-c$$$
-c$$$C Calculate gradient components.
-c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2
-c$$$ fac=-expon*(e1+evdwij)*rij_shift
-c$$$ sigder=fac*sigder
-c$$$ fac=rij*fac
-c$$$c fac=0.0d0
-c$$$C Calculate the radial part of the gradient
-c$$$ gg(1)=xj*fac
-c$$$ gg(2)=yj*fac
-c$$$ gg(3)=zj*fac
-c$$$C Calculate angular part of the gradient.
-c$$$ call sc_grad
-c$$$c$$$ enddo ! j
-c$$$c$$$ enddo ! iint
-c$$$c$$$ enddo ! i
-c$$$ energy_dec=.false.
-c$$$ return
-c$$$ end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$ subroutine perturb_side_chain(i,angle)
-c$$$ implicit none
-c$$$
-c$$$c Includes
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.CHAIN'
-c$$$ include 'COMMON.GEO'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.LOCAL'
-c$$$ include 'COMMON.IOUNITS'
-c$$$
-c$$$c External functions
-c$$$ external ran_number
-c$$$ double precision ran_number
-c$$$
-c$$$c Input arguments
-c$$$ integer i
-c$$$ double precision angle ! In degrees
-c$$$
-c$$$c Local variables
-c$$$ integer i_sc
-c$$$ double precision rad_ang,rand_v(3),length,cost,sint
-c$$$
-c$$$
-c$$$ i_sc=i+nres
-c$$$ rad_ang=angle*deg2rad
-c$$$
-c$$$ length=0.0
-c$$$ do while (length.lt.0.01)
-c$$$ rand_v(1)=ran_number(0.01D0,1.0D0)
-c$$$ rand_v(2)=ran_number(0.01D0,1.0D0)
-c$$$ rand_v(3)=ran_number(0.01D0,1.0D0)
-c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+
-c$$$ + rand_v(3)*rand_v(3)
-c$$$ length=sqrt(length)
-c$$$ rand_v(1)=rand_v(1)/length
-c$$$ rand_v(2)=rand_v(2)/length
-c$$$ rand_v(3)=rand_v(3)/length
-c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+
-c$$$ + rand_v(3)*dc_norm(3,i_sc)
-c$$$ length=1.0D0-cost*cost
-c$$$ if (length.lt.0.0D0) length=0.0D0
-c$$$ length=sqrt(length)
-c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc)
-c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc)
-c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc)
-c$$$ enddo
-c$$$ rand_v(1)=rand_v(1)/length
-c$$$ rand_v(2)=rand_v(2)/length
-c$$$ rand_v(3)=rand_v(3)/length
-c$$$
-c$$$ cost=dcos(rad_ang)
-c$$$ sint=dsin(rad_ang)
-c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint)
-c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint)
-c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint)
-c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc)
-c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc)
-c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc)
-c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc)
-c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc)
-c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc)
-c$$$
-c$$$ call chainbuild_cart
-c$$$
-c$$$ return
-c$$$ end
-c$$$
-c$$$c----------------------------------------------------------------------------
-c$$$
-c$$$ subroutine ss_relax3(i_in,j_in)
-c$$$ implicit none
-c$$$
-c$$$c Includes
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.CHAIN'
-c$$$ include 'COMMON.IOUNITS'
-c$$$ include 'COMMON.INTERACT'
-c$$$
-c$$$c External functions
-c$$$ external ran_number
-c$$$ double precision ran_number
-c$$$
-c$$$c Input arguments
-c$$$ integer i_in,j_in
-c$$$
-c$$$c Local variables
-c$$$ double precision energy_sc(0:n_ene),etot
-c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3)
-c$$$ double precision ang_pert,rand_fact,exp_fact,beta
-c$$$ integer n,i_pert,i
-c$$$ logical notdone
-c$$$
-c$$$
-c$$$ beta=1.0D0
-c$$$
-c$$$ mask_r=.true.
-c$$$ do i=nnt,nct
-c$$$ mask_side(i)=0
-c$$$ enddo
-c$$$ mask_side(i_in)=1
-c$$$ mask_side(j_in)=1
-c$$$
-c$$$ call etotal_sc(energy_sc)
-c$$$ etot=energy_sc(0)
-c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0),
-c$$$c + energy_sc(1),energy_sc(12)
-c$$$
-c$$$ notdone=.true.
-c$$$ n=0
-c$$$ do while (notdone)
-c$$$ if (mod(n,2).eq.0) then
-c$$$ i_pert=i_in
-c$$$ else
-c$$$ i_pert=j_in
-c$$$ endif
-c$$$ n=n+1
-c$$$
-c$$$ do i=1,3
-c$$$ org_dc(i)=dc(i,i_pert+nres)
-c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres)
-c$$$ org_c(i)=c(i,i_pert+nres)
-c$$$ enddo
-c$$$ ang_pert=ran_number(0.0D0,3.0D0)
-c$$$ call perturb_side_chain(i_pert,ang_pert)
-c$$$ call etotal_sc(energy_sc)
-c$$$ exp_fact=exp(beta*(etot-energy_sc(0)))
-c$$$ rand_fact=ran_number(0.0D0,1.0D0)
-c$$$ if (rand_fact.lt.exp_fact) then
-c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0),
-c$$$c + energy_sc(1),energy_sc(12)
-c$$$ etot=energy_sc(0)
-c$$$ else
-c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0),
-c$$$c + energy_sc(1),energy_sc(12)
-c$$$ do i=1,3
-c$$$ dc(i,i_pert+nres)=org_dc(i)
-c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i)
-c$$$ c(i,i_pert+nres)=org_c(i)
-c$$$ enddo
-c$$$ endif
-c$$$
-c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false.
-c$$$ enddo
-c$$$
-c$$$ mask_r=.false.
-c$$$
-c$$$ return
-c$$$ end
-c$$$
-c$$$c----------------------------------------------------------------------------
-c$$$
-c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in)
-c$$$ implicit none
-c$$$ include 'DIMENSIONS'
-c$$$ integer liv,lv
-c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2))
-c$$$*********************************************************************
-c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for *
-c$$$* the calling subprogram. *
-c$$$* when d(i)=1.0, then v(35) is the length of the initial step, *
-c$$$* calculated in the usual pythagorean way. *
-c$$$* absolute convergence occurs when the function is within v(31) of *
-c$$$* zero. unless you know the minimum value in advance, abs convg *
-c$$$* is probably not useful. *
-c$$$* relative convergence is when the model predicts that the function *
-c$$$* will decrease by less than v(32)*abs(fun). *
-c$$$*********************************************************************
-c$$$ include 'COMMON.IOUNITS'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.GEO'
-c$$$ include 'COMMON.MINIM'
-c$$$ include 'COMMON.CHAIN'
-c$$$
-c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist
-c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
-c$$$ + orig_ss_dist(maxres2,maxres2)
-c$$$
-c$$$ double precision etot
-c$$$ integer iretcode,nfun,i_in,j_in
-c$$$
-c$$$ external dist
-c$$$ double precision dist
-c$$$ external ss_func,fdum
-c$$$ double precision ss_func,fdum
-c$$$
-c$$$ integer iv(liv),uiparm(2)
-c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum
-c$$$ integer i,j,k
-c$$$
-c$$$
-c$$$ call deflt(2,iv,liv,lv,v)
-c$$$* 12 means fresh start, dont call deflt
-c$$$ iv(1)=12
-c$$$* max num of fun calls
-c$$$ if (maxfun.eq.0) maxfun=500
-c$$$ iv(17)=maxfun
-c$$$* max num of iterations
-c$$$ if (maxmin.eq.0) maxmin=1000
-c$$$ iv(18)=maxmin
-c$$$* controls output
-c$$$ iv(19)=2
-c$$$* selects output unit
-c$$$c iv(21)=iout
-c$$$ iv(21)=0
-c$$$* 1 means to print out result
-c$$$ iv(22)=0
-c$$$* 1 means to print out summary stats
-c$$$ iv(23)=0
-c$$$* 1 means to print initial x and d
-c$$$ iv(24)=0
-c$$$* min val for v(radfac) default is 0.1
-c$$$ v(24)=0.1D0
-c$$$* max val for v(radfac) default is 4.0
-c$$$ v(25)=2.0D0
-c$$$c v(25)=4.0D0
-c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
-c$$$* the sumsl default is 0.1
-c$$$ v(26)=0.1D0
-c$$$* false conv if (act fnctn decrease) .lt. v(34)
-c$$$* the sumsl default is 100*machep
-c$$$ v(34)=v(34)/100.0D0
-c$$$* absolute convergence
-c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4
-c$$$ v(31)=tolf
-c$$$ v(31)=1.0D-1
-c$$$* relative convergence
-c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4
-c$$$ v(32)=rtolf
-c$$$ v(32)=1.0D-1
-c$$$* controls initial step size
-c$$$ v(35)=1.0D-1
-c$$$* large vals of d correspond to small components of step
-c$$$ do i=1,6*nres
-c$$$ d(i)=1.0D0
-c$$$ enddo
-c$$$
-c$$$ do i=0,2*nres
-c$$$ do j=1,3
-c$$$ orig_ss_dc(j,i)=dc(j,i)
-c$$$ enddo
-c$$$ enddo
-c$$$ call geom_to_var(nvar,orig_ss_var)
-c$$$
-c$$$ do i=1,nres
-c$$$ do j=i,nres
-c$$$ orig_ss_dist(j,i)=dist(j,i)
-c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i)
-c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres)
-c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres)
-c$$$ enddo
-c$$$ enddo
-c$$$
-c$$$ k=0
-c$$$ do i=1,nres-1
-c$$$ do j=1,3
-c$$$ k=k+1
-c$$$ x(k)=dc(j,i)
-c$$$ enddo
-c$$$ enddo
-c$$$ do i=2,nres-1
-c$$$ if (ialph(i,1).gt.0) then
-c$$$ do j=1,3
-c$$$ k=k+1
-c$$$ x(k)=dc(j,i+nres)
-c$$$ enddo
-c$$$ endif
-c$$$ enddo
-c$$$
-c$$$ uiparm(1)=i_in
-c$$$ uiparm(2)=j_in
-c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum)
-c$$$ etot=v(10)
-c$$$ iretcode=iv(1)
-c$$$ nfun=iv(6)+iv(30)
-c$$$
-c$$$ k=0
-c$$$ do i=1,nres-1
-c$$$ do j=1,3
-c$$$ k=k+1
-c$$$ dc(j,i)=x(k)
-c$$$ enddo
-c$$$ enddo
-c$$$ do i=2,nres-1
-c$$$ if (ialph(i,1).gt.0) then
-c$$$ do j=1,3
-c$$$ k=k+1
-c$$$ dc(j,i+nres)=x(k)
-c$$$ enddo
-c$$$ endif
-c$$$ enddo
-c$$$ call chainbuild_cart
-c$$$
-c$$$ return
-c$$$ end
-c$$$
-c$$$C-----------------------------------------------------------------------------
-c$$$
-c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm)
-c$$$ implicit none
-c$$$ include 'DIMENSIONS'
-c$$$ include 'COMMON.DERIV'
-c$$$ include 'COMMON.IOUNITS'
-c$$$ include 'COMMON.VAR'
-c$$$ include 'COMMON.CHAIN'
-c$$$ include 'COMMON.INTERACT'
-c$$$ include 'COMMON.SBRIDGE'
-c$$$
-c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist
-c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar),
-c$$$ + orig_ss_dist(maxres2,maxres2)
-c$$$
-c$$$ integer n
-c$$$ double precision x(maxres6)
-c$$$ integer nf
-c$$$ double precision f
-c$$$ integer uiparm(2)
-c$$$ real*8 urparm(1)
-c$$$ external ufparm
-c$$$ double precision ufparm
-c$$$
-c$$$ external dist
-c$$$ double precision dist
-c$$$
-c$$$ integer i,j,k,ss_i,ss_j
-c$$$ double precision tempf,var(maxvar)
-c$$$
-c$$$
-c$$$ ss_i=uiparm(1)
-c$$$ ss_j=uiparm(2)
-c$$$ f=0.0D0
-c$$$
-c$$$ k=0
-c$$$ do i=1,nres-1
-c$$$ do j=1,3
-c$$$ k=k+1
-c$$$ dc(j,i)=x(k)
-c$$$ enddo
-c$$$ enddo
-c$$$ do i=2,nres-1
-c$$$ if (ialph(i,1).gt.0) then
-c$$$ do j=1,3
-c$$$ k=k+1
-c$$$ dc(j,i+nres)=x(k)
-c$$$ enddo
-c$$$ endif
-c$$$ enddo
-c$$$ call chainbuild_cart
-c$$$
-c$$$ call geom_to_var(nvar,var)
-c$$$
-c$$$c Constraints on all angles
-c$$$ do i=1,nvar
-c$$$ tempf=var(i)-orig_ss_var(i)
-c$$$ f=f+tempf*tempf
-c$$$ enddo
-c$$$
-c$$$c Constraints on all distances
-c$$$ do i=1,nres-1
-c$$$ if (i.gt.1) then
-c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i)
-c$$$ f=f+tempf*tempf
-c$$$ endif
-c$$$ do j=i+1,nres
-c$$$ tempf=dist(j,i)-orig_ss_dist(j,i)
-c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf
-c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i)
-c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf
-c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres)
-c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf
-c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres)
-c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf
-c$$$ enddo
-c$$$ enddo
-c$$$
-c$$$c Constraints for the relevant CYS-CYS
-c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0
-c$$$ f=f+tempf*tempf
-c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF
-c$$$
-c$$$c$$$ if (nf.ne.nfl) then
-c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf,
-c$$$c$$$ + f,dist(5+nres,14+nres)
-c$$$c$$$ endif
-c$$$
-c$$$ nfl=nf
-c$$$
-c$$$ return
-c$$$ end
-c$$$
-c$$$C-----------------------------------------------------------------------------
+++ /dev/null
- subroutine friction_force
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.IOUNITS'
- double precision gamvec(MAXRES6)
- common /syfek/ gamvec
- double precision vv(3),vvtot(3,maxres),v_work(MAXRES6),
- & ginvfric(maxres2,maxres2)
- common /przechowalnia/ ginvfric
-
- logical lprn /.false./, checkmode /.false./
-
- do i=0,MAXRES2
- do j=1,3
- friction(j,i)=0.0d0
- enddo
- enddo
-
- do j=1,3
- d_t_work(j)=d_t(j,0)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- d_t_work(ind+j)=d_t(j,i)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- d_t_work(ind+j)=d_t(j,i+nres)
- enddo
- ind=ind+3
- endif
- enddo
-
- call fricmat_mult(d_t_work,fric_work)
-
- if (.not.checkmode) return
-
- if (lprn) then
- write (iout,*) "d_t_work and fric_work"
- do i=1,3*dimen
- write (iout,'(i3,2e15.5)') i,d_t_work(i),fric_work(i)
- enddo
- endif
- do j=1,3
- friction(j,0)=fric_work(j)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- friction(j,i)=fric_work(ind+j)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- friction(j,i+nres)=fric_work(ind+j)
- enddo
- ind=ind+3
- endif
- enddo
- if (lprn) then
- write(iout,*) "Friction backbone"
- do i=0,nct-1
- write(iout,'(i5,3e15.5,5x,3e15.5)')
- & i,(friction(j,i),j=1,3),(d_t(j,i),j=1,3)
- enddo
- write(iout,*) "Friction side chain"
- do i=nnt,nct
- write(iout,'(i5,3e15.5,5x,3e15.5)')
- & i,(friction(j,i+nres),j=1,3),(d_t(j,i+nres),j=1,3)
- enddo
- endif
- if (lprn) then
- do j=1,3
- vv(j)=d_t(j,0)
- enddo
- do i=nnt,nct
- do j=1,3
- vvtot(j,i)=vv(j)+0.5d0*d_t(j,i)
- vvtot(j,i+nres)=vv(j)+d_t(j,i+nres)
- vv(j)=vv(j)+d_t(j,i)
- enddo
- enddo
- write (iout,*) "vvtot backbone and sidechain"
- do i=nnt,nct
- write (iout,'(i5,3e15.5,5x,3e15.5)') i,(vvtot(j,i),j=1,3),
- & (vvtot(j,i+nres),j=1,3)
- enddo
- ind=0
- do i=nnt,nct-1
- do j=1,3
- v_work(ind+j)=vvtot(j,i)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- do j=1,3
- v_work(ind+j)=vvtot(j,i+nres)
- enddo
- ind=ind+3
- enddo
- write (iout,*) "v_work gamvec and site-based friction forces"
- do i=1,dimen1
- write (iout,'(i5,3e15.5)') i,v_work(i),gamvec(i),
- & gamvec(i)*v_work(i)
- enddo
-c do i=1,dimen
-c fric_work1(i)=0.0d0
-c do j=1,dimen1
-c fric_work1(i)=fric_work1(i)-A(j,i)*gamvec(j)*v_work(j)
-c enddo
-c enddo
-c write (iout,*) "fric_work and fric_work1"
-c do i=1,dimen
-c write (iout,'(i5,2e15.5)') i,fric_work(i),fric_work1(i)
-c enddo
- do i=1,dimen
- do j=1,dimen
- ginvfric(i,j)=0.0d0
- do k=1,dimen
- ginvfric(i,j)=ginvfric(i,j)+ginv(i,k)*fricmat(k,j)
- enddo
- enddo
- enddo
- write (iout,*) "ginvfric"
- do i=1,dimen
- write (iout,'(i5,100f8.3)') i,(ginvfric(i,j),j=1,dimen)
- enddo
- write (iout,*) "symmetry check"
- do i=1,dimen
- do j=1,i-1
- write (iout,*) i,j,ginvfric(i,j)-ginvfric(j,i)
- enddo
- enddo
- endif
- return
- end
-c-----------------------------------------------------
- subroutine stochastic_force(stochforcvec)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
- include 'COMMON.TIME1'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.IOUNITS'
-
- double precision x,sig,lowb,highb,
- & ff(3),force(3,0:MAXRES2),zeta2,lowb2,
- & highb2,sig2,forcvec(MAXRES6),stochforcvec(MAXRES6)
- logical lprn /.false./
- do i=0,MAXRES2
- do j=1,3
- stochforc(j,i)=0.0d0
- enddo
- enddo
- x=0.0d0
-
-#ifdef MPI
- time00=MPI_Wtime()
-#else
- time00=tcpu()
-#endif
-c Compute the stochastic forces acting on bodies. Store in force.
- do i=nnt,nct-1
- sig=stdforcp(i)
- lowb=-5*sig
- highb=5*sig
- do j=1,3
- force(j,i)=anorm_distr(x,sig,lowb,highb)
- enddo
- enddo
- do i=nnt,nct
- sig2=stdforcsc(i)
- lowb2=-5*sig2
- highb2=5*sig2
- do j=1,3
- force(j,i+nres)=anorm_distr(x,sig2,lowb2,highb2)
- enddo
- enddo
-#ifdef MPI
- time_fsample=time_fsample+MPI_Wtime()-time00
-#else
- time_fsample=time_fsample+tcpu()-time00
-#endif
-c Compute the stochastic forces acting on virtual-bond vectors.
- do j=1,3
- ff(j)=0.0d0
- enddo
- do i=nct-1,nnt,-1
- do j=1,3
- stochforc(j,i)=ff(j)+0.5d0*force(j,i)
- enddo
- do j=1,3
- ff(j)=ff(j)+force(j,i)
- enddo
- if (itype(i+1).ne.21) then
- do j=1,3
- stochforc(j,i)=stochforc(j,i)+force(j,i+nres+1)
- ff(j)=ff(j)+force(j,i+nres+1)
- enddo
- endif
- enddo
- do j=1,3
- stochforc(j,0)=ff(j)+force(j,nnt+nres)
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- stochforc(j,i+nres)=force(j,i+nres)
- enddo
- endif
- enddo
-
- do j=1,3
- stochforcvec(j)=stochforc(j,0)
- enddo
- ind=3
- do i=nnt,nct-1
- do j=1,3
- stochforcvec(ind+j)=stochforc(j,i)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- if (itype(i).ne.10) then
- do j=1,3
- stochforcvec(ind+j)=stochforc(j,i+nres)
- enddo
- ind=ind+3
- endif
- enddo
- if (lprn) then
- write (iout,*) "stochforcvec"
- do i=1,3*dimen
- write(iout,'(i5,e15.5)') i,stochforcvec(i)
- enddo
- write(iout,*) "Stochastic forces backbone"
- do i=0,nct-1
- write(iout,'(i5,3e15.5)') i,(stochforc(j,i),j=1,3)
- enddo
- write(iout,*) "Stochastic forces side chain"
- do i=nnt,nct
- write(iout,'(i5,3e15.5)')
- & i,(stochforc(j,i+nres),j=1,3)
- enddo
- endif
-
- if (lprn) then
-
- ind=0
- do i=nnt,nct-1
- write (iout,*) i,ind
- do j=1,3
- forcvec(ind+j)=force(j,i)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- write (iout,*) i,ind
- do j=1,3
- forcvec(j+ind)=force(j,i+nres)
- enddo
- ind=ind+3
- enddo
-
- write (iout,*) "forcvec"
- ind=0
- do i=nnt,nct-1
- do j=1,3
- write (iout,'(2i3,2f10.5)') i,j,force(j,i),
- & forcvec(ind+j)
- enddo
- ind=ind+3
- enddo
- do i=nnt,nct
- do j=1,3
- write (iout,'(2i3,2f10.5)') i,j,force(j,i+nres),
- & forcvec(ind+j)
- enddo
- ind=ind+3
- enddo
-
- endif
-
- return
- end
-c------------------------------------------------------------------
- subroutine setup_fricmat
- implicit real*8 (a-h,o-z)
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'DIMENSIONS'
- include 'COMMON.VAR'
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.MD'
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
-c integer licznik /0/
-c save licznik
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.IOUNITS'
- integer IERROR
- integer i,j,ind,ind1,m
- logical lprn /.false./
- double precision dtdi,gamvec(MAXRES2),
- & ginvfric(maxres2,maxres2),Ghalf(mmaxres2),fcopy(maxres2,maxres2)
- common /syfek/ gamvec
- double precision work(8*maxres2)
- integer iwork(maxres2)
- common /przechowalnia/ ginvfric,Ghalf,fcopy
-#ifdef MPI
- if (fg_rank.ne.king) goto 10
-#endif
-c Zeroing out fricmat
- do i=1,dimen
- do j=1,dimen
- fricmat(i,j)=0.0d0
- enddo
- enddo
-c Load the friction coefficients corresponding to peptide groups
- ind1=0
- do i=nnt,nct-1
- ind1=ind1+1
- gamvec(ind1)=gamp
- enddo
-c Load the friction coefficients corresponding to side chains
- m=nct-nnt
- ind=0
- do i=nnt,nct
- ind=ind+1
- ii = ind+m
- iti=itype(i)
- gamvec(ii)=gamsc(iti)
- enddo
- if (surfarea) call sdarea(gamvec)
-c if (lprn) then
-c write (iout,*) "Matrix A and vector gamma"
-c do i=1,dimen1
-c write (iout,'(i2,$)') i
-c do j=1,dimen
-c write (iout,'(f4.1,$)') A(i,j)
-c enddo
-c write (iout,'(f8.3)') gamvec(i)
-c enddo
-c endif
- if (lprn) then
- write (iout,*) "Vector gamvec"
- do i=1,dimen1
- write (iout,'(i5,f10.5)') i, gamvec(i)
- enddo
- endif
-
-c The friction matrix
- do k=1,dimen
- do i=1,dimen
- dtdi=0.0d0
- do j=1,dimen1
- dtdi=dtdi+A(j,k)*A(j,i)*gamvec(j)
- enddo
- fricmat(k,i)=dtdi
- enddo
- enddo
-
- if (lprn) then
- write (iout,'(//a)') "Matrix fricmat"
- call matout2(dimen,dimen,maxres2,maxres2,fricmat)
- endif
- if (lang.eq.2 .or. lang.eq.3) then
-c Mass-scale the friction matrix if non-direct integration will be performed
- do i=1,dimen
- do j=1,dimen
- Ginvfric(i,j)=0.0d0
- do k=1,dimen
- do l=1,dimen
- Ginvfric(i,j)=Ginvfric(i,j)+
- & Gsqrm(i,k)*Gsqrm(l,j)*fricmat(k,l)
- enddo
- enddo
- enddo
- enddo
-c Diagonalize the friction matrix
- ind=0
- do i=1,dimen
- do j=1,i
- ind=ind+1
- Ghalf(ind)=Ginvfric(i,j)
- enddo
- enddo
- call gldiag(maxres2,dimen,dimen,Ghalf,work,fricgam,fricvec,
- & ierr,iwork)
- if (lprn) then
- write (iout,'(//2a)') "Eigenvectors and eigenvalues of the",
- & " mass-scaled friction matrix"
- call eigout(dimen,dimen,maxres2,maxres2,fricvec,fricgam)
- endif
-c Precompute matrices for tinker stochastic integrator
-#ifndef LANG0
- do i=1,dimen
- do j=1,dimen
- mt1(i,j)=0.0d0
- mt2(i,j)=0.0d0
- do k=1,dimen
- mt1(i,j)=mt1(i,j)+fricvec(k,i)*gsqrm(k,j)
- mt2(i,j)=mt2(i,j)+fricvec(k,i)*gsqrp(k,j)
- enddo
- mt3(j,i)=mt1(i,j)
- enddo
- enddo
-#endif
- else if (lang.eq.4) then
-c Diagonalize the friction matrix
- ind=0
- do i=1,dimen
- do j=1,i
- ind=ind+1
- Ghalf(ind)=fricmat(i,j)
- enddo
- enddo
- call gldiag(maxres2,dimen,dimen,Ghalf,work,fricgam,fricvec,
- & ierr,iwork)
- if (lprn) then
- write (iout,'(//2a)') "Eigenvectors and eigenvalues of the",
- & " friction matrix"
- call eigout(dimen,dimen,maxres2,maxres2,fricvec,fricgam)
- endif
-c Determine the number of zero eigenvalues of the friction matrix
- nzero=max0(dimen-dimen1,0)
-c do while (fricgam(nzero+1).le.1.0d-5 .and. nzero.lt.dimen)
-c nzero=nzero+1
-c enddo
- write (iout,*) "Number of zero eigenvalues:",nzero
- do i=1,dimen
- do j=1,dimen
- fricmat(i,j)=0.0d0
- do k=nzero+1,dimen
- fricmat(i,j)=fricmat(i,j)
- & +fricvec(i,k)*fricvec(j,k)/fricgam(k)
- enddo
- enddo
- enddo
- if (lprn) then
- write (iout,'(//a)') "Generalized inverse of fricmat"
- call matout(dimen,dimen,maxres6,maxres6,fricmat)
- endif
- endif
-#ifdef MPI
- 10 continue
- if (nfgtasks.gt.1) then
- if (fg_rank.eq.0) then
-c The matching BROADCAST for fg processors is called in ERGASTULUM
-#ifdef MPI
- time00=MPI_Wtime()
-#else
- time00=tcpu()
-#endif
- call MPI_Bcast(10,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#ifdef MPI
- time_Bcast=time_Bcast+MPI_Wtime()-time00
-#else
- time_Bcast=time_Bcast+tcpu()-time00
-#endif
-c print *,"Processor",myrank,
-c & " BROADCAST iorder in SETUP_FRICMAT"
- endif
-c licznik=licznik+1
-c write (iout,*) "setup_fricmat licznik",licznik
-#ifdef MPI
- time00=MPI_Wtime()
-#else
- time00=tcpu()
-#endif
-c Scatter the friction matrix
- call MPI_Scatterv(fricmat(1,1),nginv_counts(0),
- & nginv_start(0),MPI_DOUBLE_PRECISION,fcopy(1,1),
- & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
-#ifdef TIMING
-#ifdef MPI
- time_scatter=time_scatter+MPI_Wtime()-time00
- time_scatter_fmat=time_scatter_fmat+MPI_Wtime()-time00
-#else
- time_scatter=time_scatter+tcpu()-time00
- time_scatter_fmat=time_scatter_fmat+tcpu()-time00
-#endif
-#endif
- do i=1,dimen
- do j=1,2*my_ng_count
- fricmat(j,i)=fcopy(i,j)
- enddo
- enddo
-c write (iout,*) "My chunk of fricmat"
-c call MATOUT2(my_ng_count,dimen,maxres2,maxres2,fcopy)
- endif
-#endif
- return
- end
-c-------------------------------------------------------------------------------
- subroutine sdarea(gamvec)
-c
-c Scale the friction coefficients according to solvent accessible surface areas
-c Code adapted from TINKER
-c AL 9/3/04
-c
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CONTROL'
- include 'COMMON.VAR'
- include 'COMMON.MD'
-#ifndef LANG0
- include 'COMMON.LANGEVIN'
-#else
- include 'COMMON.LANGEVIN.lang0'
-#endif
- include 'COMMON.CHAIN'
- include 'COMMON.DERIV'
- include 'COMMON.GEO'
- include 'COMMON.LOCAL'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.NAMES'
- double precision radius(maxres2),gamvec(maxres2)
- parameter (twosix=1.122462048309372981d0)
- logical lprn /.false./
-c
-c determine new friction coefficients every few SD steps
-c
-c set the atomic radii to estimates of sigma values
-c
-c print *,"Entered sdarea"
- probe = 0.0d0
-
- do i=1,2*nres
- radius(i)=0.0d0
- enddo
-c Load peptide group radii
- do i=nnt,nct-1
- radius(i)=pstok
- enddo
-c Load side chain radii
- do i=nnt,nct
- iti=itype(i)
- radius(i+nres)=restok(iti)
- enddo
-c do i=1,2*nres
-c write (iout,*) "i",i," radius",radius(i)
-c enddo
- do i = 1, 2*nres
- radius(i) = radius(i) / twosix
- if (radius(i) .ne. 0.0d0) radius(i) = radius(i) + probe
- end do
-c
-c scale atomic friction coefficients by accessible area
-c
- if (lprn) write (iout,*)
- & "Original gammas, surface areas, scaling factors, new gammas, ",
- & "std's of stochastic forces"
- ind=0
- do i=nnt,nct-1
- if (radius(i).gt.0.0d0) then
- call surfatom (i,area,radius)
- ratio = dmax1(area/(4.0d0*pi*radius(i)**2),1.0d-1)
- if (lprn) write (iout,'(i5,3f10.5,$)')
- & i,gamvec(ind+1),area,ratio
- do j=1,3
- ind=ind+1
- gamvec(ind) = ratio * gamvec(ind)
- enddo
- stdforcp(i)=stdfp*dsqrt(gamvec(ind))
- if (lprn) write (iout,'(2f10.5)') gamvec(ind),stdforcp(i)
- endif
- enddo
- do i=nnt,nct
- if (radius(i+nres).gt.0.0d0) then
- call surfatom (i+nres,area,radius)
- ratio = dmax1(area/(4.0d0*pi*radius(i+nres)**2),1.0d-1)
- if (lprn) write (iout,'(i5,3f10.5,$)')
- & i,gamvec(ind+1),area,ratio
- do j=1,3
- ind=ind+1
- gamvec(ind) = ratio * gamvec(ind)
- enddo
- stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamvec(ind))
- if (lprn) write (iout,'(2f10.5)') gamvec(ind),stdforcsc(i)
- endif
- enddo
-
- return
- end
+++ /dev/null
- subroutine sumsl(n, d, x, calcf, calcg, iv, liv, lv, v,
- 1 uiparm, urparm, ufparm)
-c
-c *** minimize general unconstrained objective function using ***
-c *** analytic gradient and hessian approx. from secant update ***
-c
- integer n, liv, lv
- integer iv(liv), uiparm(1)
- double precision d(n), x(n), v(lv), urparm(1)
-c dimension v(71 + n*(n+15)/2), uiparm(*), urparm(*)
- external calcf, calcg, ufparm
-c
-c *** purpose ***
-c
-c this routine interacts with subroutine sumit in an attempt
-c to find an n-vector x* that minimizes the (unconstrained)
-c objective function computed by calcf. (often the x* found is
-c a local minimizer rather than a global one.)
-c
-c-------------------------- parameter usage --------------------------
-c
-c n........ (input) the number of variables on which f depends, i.e.,
-c the number of components in x.
-c d........ (input/output) a scale vector such that d(i)*x(i),
-c i = 1,2,...,n, are all in comparable units.
-c d can strongly affect the behavior of sumsl.
-c finding the best choice of d is generally a trial-
-c and-error process. choosing d so that d(i)*x(i)
-c has about the same value for all i often works well.
-c the defaults provided by subroutine deflt (see i
-c below) require the caller to supply d.
-c x........ (input/output) before (initially) calling sumsl, the call-
-c er should set x to an initial guess at x*. when
-c sumsl returns, x contains the best point so far
-c found, i.e., the one that gives the least value so
-c far seen for f(x).
-c calcf.... (input) a subroutine that, given x, computes f(x). calcf
-c must be declared external in the calling program.
-c it is invoked by
-c call calcf(n, x, nf, f, uiparm, urparm, ufparm)
-c when calcf is called, nf is the invocation
-c count for calcf. nf is included for possible use
-c with calcg. if x is out of bounds (e.g., if it
-c would cause overflow in computing f(x)), then calcf
-c should set nf to 0. this will cause a shorter step
-c to be attempted. (if x is in bounds, then calcf
-c should not change nf.) the other parameters are as
-c described above and below. calcf should not change
-c n, p, or x.
-c calcg.... (input) a subroutine that, given x, computes g(x), the gra-
-c dient of f at x. calcg must be declared external in
-c the calling program. it is invoked by
-c call calcg(n, x, nf, g, uiparm, urparm, ufaprm)
-c when calcg is called, nf is the invocation
-c count for calcf at the time f(x) was evaluated. the
-c x passed to calcg is usually the one passed to calcf
-c on either its most recent invocation or the one
-c prior to it. if calcf saves intermediate results
-c for use by calcg, then it is possible to tell from
-c nf whether they are valid for the current x (or
-c which copy is valid if two copies are kept). if g
-c cannot be computed at x, then calcg should set nf to
-c 0. in this case, sumsl will return with iv(1) = 65.
-c (if g can be computed at x, then calcg should not
-c changed nf.) the other parameters to calcg are as
-c described above and below. calcg should not change
-c n or x.
-c iv....... (input/output) an integer value array of length liv (see
-c below) that helps control the sumsl algorithm and
-c that is used to store various intermediate quanti-
-c ties. of particular interest are the initialization/
-c return code iv(1) and the entries in iv that control
-c printing and limit the number of iterations and func-
-c tion evaluations. see the section on iv input
-c values below.
-c liv...... (input) length of iv array. must be at least 60. if li
-c is too small, then sumsl returns with iv(1) = 15.
-c when sumsl returns, the smallest allowed value of
-c liv is stored in iv(lastiv) -- see the section on
-c iv output values below. (this is intended for use
-c with extensions of sumsl that handle constraints.)
-c lv....... (input) length of v array. must be at least 71+n*(n+15)/2.
-c (at least 77+n*(n+17)/2 for smsno, at least
-c 78+n*(n+12) for humsl). if lv is too small, then
-c sumsl returns with iv(1) = 16. when sumsl returns,
-c the smallest allowed value of lv is stored in
-c iv(lastv) -- see the section on iv output values
-c below.
-c v........ (input/output) a floating-point value array of length l
-c (see below) that helps control the sumsl algorithm
-c and that is used to store various intermediate
-c quantities. of particular interest are the entries
-c in v that limit the length of the first step
-c attempted (lmax0) and specify convergence tolerances
-c (afctol, lmaxs, rfctol, sctol, xctol, xftol).
-c uiparm... (input) user integer parameter array passed without change
-c to calcf and calcg.
-c urparm... (input) user floating-point parameter array passed without
-c change to calcf and calcg.
-c ufparm... (input) user external subroutine or function passed without
-c change to calcf and calcg.
-c
-c *** iv input values (from subroutine deflt) ***
-c
-c iv(1)... on input, iv(1) should have a value between 0 and 14......
-c 0 and 12 mean this is a fresh start. 0 means that
-c deflt(2, iv, liv, lv, v)
-c is to be called to provide all default values to iv and
-c v. 12 (the value that deflt assigns to iv(1)) means the
-c caller has already called deflt and has possibly changed
-c some iv and/or v entries to non-default values.
-c 13 means deflt has been called and that sumsl (and
-c sumit) should only do their storage allocation. that is,
-c they should set the output components of iv that tell
-c where various subarrays arrays of v begin, such as iv(g)
-c (and, for humsl and humit only, iv(dtol)), and return.
-c 14 means that a storage has been allocated (by a call
-c with iv(1) = 13) and that the algorithm should be
-c started. when called with iv(1) = 13, sumsl returns
-c iv(1) = 14 unless liv or lv is too small (or n is not
-c positive). default = 12.
-c iv(inith).... iv(25) tells whether the hessian approximation h should
-c be initialized. 1 (the default) means sumit should
-c initialize h to the diagonal matrix whose i-th diagonal
-c element is d(i)**2. 0 means the caller has supplied a
-c cholesky factor l of the initial hessian approximation
-c h = l*(l**t) in v, starting at v(iv(lmat)) = v(iv(42))
-c (and stored compactly by rows). note that iv(lmat) may
-c be initialized by calling sumsl with iv(1) = 13 (see
-c the iv(1) discussion above). default = 1.
-c iv(mxfcal)... iv(17) gives the maximum number of function evaluations
-c (calls on calcf) allowed. if this number does not suf-
-c fice, then sumsl returns with iv(1) = 9. default = 200.
-c iv(mxiter)... iv(18) gives the maximum number of iterations allowed.
-c it also indirectly limits the number of gradient evalua-
-c tions (calls on calcg) to iv(mxiter) + 1. if iv(mxiter)
-c iterations do not suffice, then sumsl returns with
-c iv(1) = 10. default = 150.
-c iv(outlev)... iv(19) controls the number and length of iteration sum-
-c mary lines printed (by itsum). iv(outlev) = 0 means do
-c not print any summary lines. otherwise, print a summary
-c line after each abs(iv(outlev)) iterations. if iv(outlev)
-c is positive, then summary lines of length 78 (plus carri-
-c age control) are printed, including the following... the
-c iteration and function evaluation counts, f = the current
-c function value, relative difference in function values
-c achieved by the latest step (i.e., reldf = (f0-v(f))/f01,
-c where f01 is the maximum of abs(v(f)) and abs(v(f0)) and
-c v(f0) is the function value from the previous itera-
-c tion), the relative function reduction predicted for the
-c step just taken (i.e., preldf = v(preduc) / f01, where
-c v(preduc) is described below), the scaled relative change
-c in x (see v(reldx) below), the step parameter for the
-c step just taken (stppar = 0 means a full newton step,
-c between 0 and 1 means a relaxed newton step, between 1
-c and 2 means a double dogleg step, greater than 2 means
-c a scaled down cauchy step -- see subroutine dbldog), the
-c 2-norm of the scale vector d times the step just taken
-c (see v(dstnrm) below), and npreldf, i.e.,
-c v(nreduc)/f01, where v(nreduc) is described below -- if
-c npreldf is positive, then it is the relative function
-c reduction predicted for a newton step (one with
-c stppar = 0). if npreldf is negative, then it is the
-c negative of the relative function reduction predicted
-c for a step computed with step bound v(lmaxs) for use in
-c testing for singular convergence.
-c if iv(outlev) is negative, then lines of length 50
-c are printed, including only the first 6 items listed
-c above (through reldx).
-c default = 1.
-c iv(parprt)... iv(20) = 1 means print any nondefault v values on a
-c fresh start or any changed v values on a restart.
-c iv(parprt) = 0 means skip this printing. default = 1.
-c iv(prunit)... iv(21) is the output unit number on which all printing
-c is done. iv(prunit) = 0 means suppress all printing.
-c default = standard output unit (unit 6 on most systems).
-c iv(solprt)... iv(22) = 1 means print out the value of x returned (as
-c well as the gradient and the scale vector d).
-c iv(solprt) = 0 means skip this printing. default = 1.
-c iv(statpr)... iv(23) = 1 means print summary statistics upon return-
-c ing. these consist of the function value, the scaled
-c relative change in x caused by the most recent step (see
-c v(reldx) below), the number of function and gradient
-c evaluations (calls on calcf and calcg), and the relative
-c function reductions predicted for the last step taken and
-c for a newton step (or perhaps a step bounded by v(lmaxs)
-c -- see the descriptions of preldf and npreldf under
-c iv(outlev) above).
-c iv(statpr) = 0 means skip this printing.
-c iv(statpr) = -1 means skip this printing as well as that
-c of the one-line termination reason message. default = 1.
-c iv(x0prt).... iv(24) = 1 means print the initial x and scale vector d
-c (on a fresh start only). iv(x0prt) = 0 means skip this
-c printing. default = 1.
-c
-c *** (selected) iv output values ***
-c
-c iv(1)........ on output, iv(1) is a return code....
-c 3 = x-convergence. the scaled relative difference (see
-c v(reldx)) between the current parameter vector x and
-c a locally optimal parameter vector is very likely at
-c most v(xctol).
-c 4 = relative function convergence. the relative differ-
-c ence between the current function value and its lo-
-c cally optimal value is very likely at most v(rfctol).
-c 5 = both x- and relative function convergence (i.e., the
-c conditions for iv(1) = 3 and iv(1) = 4 both hold).
-c 6 = absolute function convergence. the current function
-c value is at most v(afctol) in absolute value.
-c 7 = singular convergence. the hessian near the current
-c iterate appears to be singular or nearly so, and a
-c step of length at most v(lmaxs) is unlikely to yield
-c a relative function decrease of more than v(sctol).
-c 8 = false convergence. the iterates appear to be converg-
-c ing to a noncritical point. this may mean that the
-c convergence tolerances (v(afctol), v(rfctol),
-c v(xctol)) are too small for the accuracy to which
-c the function and gradient are being computed, that
-c there is an error in computing the gradient, or that
-c the function or gradient is discontinuous near x.
-c 9 = function evaluation limit reached without other con-
-c vergence (see iv(mxfcal)).
-c 10 = iteration limit reached without other convergence
-c (see iv(mxiter)).
-c 11 = stopx returned .true. (external interrupt). see the
-c usage notes below.
-c 14 = storage has been allocated (after a call with
-c iv(1) = 13).
-c 17 = restart attempted with n changed.
-c 18 = d has a negative component and iv(dtype) .le. 0.
-c 19...43 = v(iv(1)) is out of range.
-c 63 = f(x) cannot be computed at the initial x.
-c 64 = bad parameters passed to assess (which should not
-c occur).
-c 65 = the gradient could not be computed at x (see calcg
-c above).
-c 67 = bad first parameter to deflt.
-c 80 = iv(1) was out of range.
-c 81 = n is not positive.
-c iv(g)........ iv(28) is the starting subscript in v of the current
-c gradient vector (the one corresponding to x).
-c iv(lastiv)... iv(44) is the least acceptable value of liv. (it is
-c only set if liv is at least 44.)
-c iv(lastv).... iv(45) is the least acceptable value of lv. (it is
-c only set if liv is large enough, at least iv(lastiv).)
-c iv(nfcall)... iv(6) is the number of calls so far made on calcf (i.e.,
-c function evaluations).
-c iv(ngcall)... iv(30) is the number of gradient evaluations (calls on
-c calcg).
-c iv(niter).... iv(31) is the number of iterations performed.
-c
-c *** (selected) v input values (from subroutine deflt) ***
-c
-c v(bias)..... v(43) is the bias parameter used in subroutine dbldog --
-c see that subroutine for details. default = 0.8.
-c v(afctol)... v(31) is the absolute function convergence tolerance.
-c if sumsl finds a point where the function value is less
-c than v(afctol) in absolute value, and if sumsl does not
-c return with iv(1) = 3, 4, or 5, then it returns with
-c iv(1) = 6. this test can be turned off by setting
-c v(afctol) to zero. default = max(10**-20, machep**2),
-c where machep is the unit roundoff.
-c v(dinit).... v(38), if nonnegative, is the value to which the scale
-c vector d is initialized. default = -1.
-c v(lmax0).... v(35) gives the maximum 2-norm allowed for d times the
-c very first step that sumsl attempts. this parameter can
-c markedly affect the performance of sumsl.
-c v(lmaxs).... v(36) is used in testing for singular convergence -- if
-c the function reduction predicted for a step of length
-c bounded by v(lmaxs) is at most v(sctol) * abs(f0), where
-c f0 is the function value at the start of the current
-c iteration, and if sumsl does not return with iv(1) = 3,
-c 4, 5, or 6, then it returns with iv(1) = 7. default = 1.
-c v(rfctol)... v(32) is the relative function convergence tolerance.
-c if the current model predicts a maximum possible function
-c reduction (see v(nreduc)) of at most v(rfctol)*abs(f0)
-c at the start of the current iteration, where f0 is the
-c then current function value, and if the last step attempt-
-c ed achieved no more than twice the predicted function
-c decrease, then sumsl returns with iv(1) = 4 (or 5).
-c default = max(10**-10, machep**(2/3)), where machep is
-c the unit roundoff.
-c v(sctol).... v(37) is the singular convergence tolerance -- see the
-c description of v(lmaxs) above.
-c v(tuner1)... v(26) helps decide when to check for false convergence.
-c this is done if the actual function decrease from the
-c current step is no more than v(tuner1) times its predict-
-c ed value. default = 0.1.
-c v(xctol).... v(33) is the x-convergence tolerance. if a newton step
-c (see v(nreduc)) is tried that has v(reldx) .le. v(xctol)
-c and if this step yields at most twice the predicted func-
-c tion decrease, then sumsl returns with iv(1) = 3 (or 5).
-c (see the description of v(reldx) below.)
-c default = machep**0.5, where machep is the unit roundoff.
-c v(xftol).... v(34) is the false convergence tolerance. if a step is
-c tried that gives no more than v(tuner1) times the predict-
-c ed function decrease and that has v(reldx) .le. v(xftol),
-c and if sumsl does not return with iv(1) = 3, 4, 5, 6, or
-c 7, then it returns with iv(1) = 8. (see the description
-c of v(reldx) below.) default = 100*machep, where
-c machep is the unit roundoff.
-c v(*)........ deflt supplies to v a number of tuning constants, with
-c which it should ordinarily be unnecessary to tinker. see
-c section 17 of version 2.2 of the nl2sol usage summary
-c (i.e., the appendix to ref. 1) for details on v(i),
-c i = decfac, incfac, phmnfc, phmxfc, rdfcmn, rdfcmx,
-c tuner2, tuner3, tuner4, tuner5.
-c
-c *** (selected) v output values ***
-c
-c v(dgnorm)... v(1) is the 2-norm of (diag(d)**-1)*g, where g is the
-c most recently computed gradient.
-c v(dstnrm)... v(2) is the 2-norm of diag(d)*step, where step is the
-c current step.
-c v(f)........ v(10) is the current function value.
-c v(f0)....... v(13) is the function value at the start of the current
-c iteration.
-c v(nreduc)... v(6), if positive, is the maximum function reduction
-c possible according to the current model, i.e., the func-
-c tion reduction predicted for a newton step (i.e.,
-c step = -h**-1 * g, where g is the current gradient and
-c h is the current hessian approximation).
-c if v(nreduc) is negative, then it is the negative of
-c the function reduction predicted for a step computed with
-c a step bound of v(lmaxs) for use in testing for singular
-c convergence.
-c v(preduc)... v(7) is the function reduction predicted (by the current
-c quadratic model) for the current step. this (divided by
-c v(f0)) is used in testing for relative function
-c convergence.
-c v(reldx).... v(17) is the scaled relative change in x caused by the
-c current step, computed as
-c max(abs(d(i)*(x(i)-x0(i)), 1 .le. i .le. p) /
-c max(d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p),
-c where x = x0 + step.
-c
-c------------------------------- notes -------------------------------
-c
-c *** algorithm notes ***
-c
-c this routine uses a hessian approximation computed from the
-c bfgs update (see ref 3). only a cholesky factor of the hessian
-c approximation is stored, and this is updated using ideas from
-c ref. 4. steps are computed by the double dogleg scheme described
-c in ref. 2. the steps are assessed as in ref. 1.
-c
-c *** usage notes ***
-c
-c after a return with iv(1) .le. 11, it is possible to restart,
-c i.e., to change some of the iv and v input values described above
-c and continue the algorithm from the point where it was interrupt-
-c ed. iv(1) should not be changed, nor should any entries of i
-c and v other than the input values (those supplied by deflt).
-c those who do not wish to write a calcg which computes the
-c gradient analytically should call smsno rather than sumsl.
-c smsno uses finite differences to compute an approximate gradient.
-c those who would prefer to provide f and g (the function and
-c gradient) by reverse communication rather than by writing subrou-
-c tines calcf and calcg may call on sumit directly. see the com-
-c ments at the beginning of sumit.
-c those who use sumsl interactively may wish to supply their
-c own stopx function, which should return .true. if the break key
-c has been pressed since stopx was last invoked. this makes it
-c possible to externally interrupt sumsl (which will return with
-c iv(1) = 11 if stopx returns .true.).
-c storage for g is allocated at the end of v. thus the caller
-c may make v longer than specified above and may allow calcg to use
-c elements of g beyond the first n as scratch storage.
-c
-c *** portability notes ***
-c
-c the sumsl distribution tape contains both single- and double-
-c precision versions of the sumsl source code, so it should be un-
-c necessary to change precisions.
-c only the functions imdcon and rmdcon contain machine-dependent
-c constants. to change from one machine to another, it should
-c suffice to change the (few) relevant lines in these functions.
-c intrinsic functions are explicitly declared. on certain com-
-c puters (e.g. univac), it may be necessary to comment out these
-c declarations. so that this may be done automatically by a simple
-c program, such declarations are preceded by a comment having c/+
-c in columns 1-3 and blanks in columns 4-72 and are followed by
-c a comment having c/ in columns 1 and 2 and blanks in columns 3-72.
-c the sumsl source code is expressed in 1966 ansi standard
-c fortran. it may be converted to fortran 77 by commenting out all
-c lines that fall between a line having c/6 in columns 1-3 and a
-c line having c/7 in columns 1-3 and by removing (i.e., replacing
-c by a blank) the c in column 1 of the lines that follow the c/7
-c line and precede a line having c/ in columns 1-2 and blanks in
-c columns 3-72. these changes convert some data statements into
-c parameter statements, convert some variables from real to
-c character*4, and make the data statements that initialize these
-c variables use character strings delimited by primes instead
-c of hollerith constants. (such variables and data statements
-c appear only in modules itsum and parck. parameter statements
-c appear nearly everywhere.) these changes also add save state-
-c ments for variables given machine-dependent constants by rmdcon.
-c
-c *** references ***
-c
-c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), algorithm 573 --
-c an adaptive nonlinear least-squares algorithm, acm trans.
-c math. software 7, pp. 369-383.
-c
-c 2. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti-
-c mization algorithms which use function and gradient
-c values, j. optim. theory applic. 28, pp. 453-482.
-c
-c 3. dennis, j.e., and more, j.j. (1977), quasi-newton methods, motiva-
-c tion and theory, siam rev. 19, pp. 46-89.
-c
-c 4. goldfarb, d. (1976), factorized variable metric methods for uncon-
-c strained optimization, math. comput. 30, pp. 796-811.
-c
-c *** general ***
-c
-c coded by david m. gay (winter 1980). revised summer 1982.
-c this subroutine was written in connection with research
-c supported in part by the national science foundation under
-c grants mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989,
-c and mcs-7906671.
-c.
-c
-c---------------------------- declarations ---------------------------
-c
- external deflt, sumit
-c
-c deflt... supplies default iv and v input components.
-c sumit... reverse-communication routine that carries out sumsl algo-
-c rithm.
-c
- integer g1, iv1, nf
- double precision f
-c
-c *** subscripts for iv ***
-c
- integer nextv, nfcall, nfgcal, g, toobig, vneed
-c
-c/6
-c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, toobig/2/, vneed/4/
-c/7
- parameter (nextv=47, nfcall=6, nfgcal=7, g=28, toobig=2, vneed=4)
-c/
-c
-c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++
-c
- if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v)
- iv1 = iv(1)
- if (iv1 .eq. 12 .or. iv1 .eq. 13) iv(vneed) = iv(vneed) + n
- if (iv1 .eq. 14) go to 10
- if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10
- g1 = 1
- if (iv1 .eq. 12) iv(1) = 13
- go to 20
-c
- 10 g1 = iv(g)
-c
- 20 call sumit(d, f, v(g1), iv, liv, lv, n, v, x)
- if (iv(1) - 2) 30, 40, 50
-c
- 30 nf = iv(nfcall)
- call calcf(n, x, nf, f, uiparm, urparm, ufparm)
- if (nf .le. 0) iv(toobig) = 1
- go to 20
-c
- 40 call calcg(n, x, iv(nfgcal), v(g1), uiparm, urparm, ufparm)
- go to 20
-c
- 50 if (iv(1) .ne. 14) go to 999
-c
-c *** storage allocation
-c
- iv(g) = iv(nextv)
- iv(nextv) = iv(g) + n
- if (iv1 .ne. 13) go to 10
-c
- 999 return
-c *** last card of sumsl follows ***
- end
- subroutine sumit(d, fx, g, iv, liv, lv, n, v, x)
-c
-c *** carry out sumsl (unconstrained minimization) iterations, using
-c *** double-dogleg/bfgs steps.
-c
-c *** parameter declarations ***
-c
- integer liv, lv, n
- integer iv(liv)
- double precision d(n), fx, g(n), v(lv), x(n)
-c
-c-------------------------- parameter usage --------------------------
-c
-c d.... scale vector.
-c fx... function value.
-c g.... gradient vector.
-c iv... integer value array.
-c liv.. length of iv (at least 60).
-c lv... length of v (at least 71 + n*(n+13)/2).
-c n.... number of variables (components in x and g).
-c v.... floating-point value array.
-c x.... vector of parameters to be optimized.
-c
-c *** discussion ***
-c
-c parameters iv, n, v, and x are the same as the corresponding
-c ones to sumsl (which see), except that v can be shorter (since
-c the part of v that sumsl uses for storing g is not needed).
-c moreover, compared with sumsl, iv(1) may have the two additional
-c output values 1 and 2, which are explained below, as is the use
-c of iv(toobig) and iv(nfgcal). the value iv(g), which is an
-c output value from sumsl (and smsno), is not referenced by
-c sumit or the subroutines it calls.
-c fx and g need not have been initialized when sumit is called
-c with iv(1) = 12, 13, or 14.
-c
-c iv(1) = 1 means the caller should set fx to f(x), the function value
-c at x, and call sumit again, having changed none of the
-c other parameters. an exception occurs if f(x) cannot be
-c (e.g. if overflow would occur), which may happen because
-c of an oversized step. in this case the caller should set
-c iv(toobig) = iv(2) to 1, which will cause sumit to ig-
-c nore fx and try a smaller step. the parameter nf that
-c sumsl passes to calcf (for possible use by calcg) is a
-c copy of iv(nfcall) = iv(6).
-c iv(1) = 2 means the caller should set g to g(x), the gradient vector
-c of f at x, and call sumit again, having changed none of
-c the other parameters except possibly the scale vector d
-c when iv(dtype) = 0. the parameter nf that sumsl passes
-c to calcg is iv(nfgcal) = iv(7). if g(x) cannot be
-c evaluated, then the caller may set iv(nfgcal) to 0, in
-c which case sumit will return with iv(1) = 65.
-c.
-c *** general ***
-c
-c coded by david m. gay (december 1979). revised sept. 1982.
-c this subroutine was written in connection with research supported
-c in part by the national science foundation under grants
-c mcs-7600324 and mcs-7906671.
-c
-c (see sumsl for references.)
-c
-c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++
-c
-c *** local variables ***
-c
- integer dg1, dummy, g01, i, k, l, lstgst, nwtst1, step1,
- 1 temp1, w, x01, z
- double precision t
-c
-c *** constants ***
-c
- double precision half, negone, one, onep2, zero
-c
-c *** no intrinsic functions ***
-c
-c *** external functions and subroutines ***
-c
- external assst, dbdog, deflt, dotprd, itsum, litvmu, livmul,
- 1 ltvmul, lupdat, lvmul, parck, reldst, stopx, vaxpy,
- 2 vcopy, vscopy, vvmulp, v2norm, wzbfgs
- logical stopx
- double precision dotprd, reldst, v2norm
-c
-c assst.... assesses candidate step.
-c dbdog.... computes double-dogleg (candidate) step.
-c deflt.... supplies default iv and v input components.
-c dotprd... returns inner product of two vectors.
-c itsum.... prints iteration summary and info on initial and final x.
-c litvmu... multiplies inverse transpose of lower triangle times vector.
-c livmul... multiplies inverse of lower triangle times vector.
-c ltvmul... multiplies transpose of lower triangle times vector.
-c lupdt.... updates cholesky factor of hessian approximation.
-c lvmul.... multiplies lower triangle times vector.
-c parck.... checks validity of input iv and v values.
-c reldst... computes v(reldx) = relative step size.
-c stopx.... returns .true. if the break key has been pressed.
-c vaxpy.... computes scalar times one vector plus another.
-c vcopy.... copies one vector to another.
-c vscopy... sets all elements of a vector to a scalar.
-c vvmulp... multiplies vector by vector raised to power (componentwise).
-c v2norm... returns the 2-norm of a vector.
-c wzbfgs... computes w and z for lupdat corresponding to bfgs update.
-c
-c *** subscripts for iv and v ***
-c
- integer afctol
- integer cnvcod, dg, dgnorm, dinit, dstnrm, dst0, f, f0, fdif,
- 1 gthg, gtstep, g0, incfac, inith, irc, kagqt, lmat, lmax0,
- 2 lmaxs, mode, model, mxfcal, mxiter, nextv, nfcall, nfgcal,
- 3 ngcall, niter, nreduc, nwtstp, preduc, radfac, radinc,
- 4 radius, rad0, reldx, restor, step, stglim, stlstg, toobig,
- 5 tuner4, tuner5, vneed, xirc, x0
-c
-c *** iv subscript values ***
-c
-c/6
-c data cnvcod/55/, dg/37/, g0/48/, inith/25/, irc/29/, kagqt/33/,
-c 1 mode/35/, model/5/, mxfcal/17/, mxiter/18/, nfcall/6/,
-c 2 nfgcal/7/, ngcall/30/, niter/31/, nwtstp/34/, radinc/8/,
-c 3 restor/9/, step/40/, stglim/11/, stlstg/41/, toobig/2/,
-c 4 vneed/4/, xirc/13/, x0/43/
-c/7
- parameter (cnvcod=55, dg=37, g0=48, inith=25, irc=29, kagqt=33,
- 1 mode=35, model=5, mxfcal=17, mxiter=18, nfcall=6,
- 2 nfgcal=7, ngcall=30, niter=31, nwtstp=34, radinc=8,
- 3 restor=9, step=40, stglim=11, stlstg=41, toobig=2,
- 4 vneed=4, xirc=13, x0=43)
-c/
-c
-c *** v subscript values ***
-c
-c/6
-c data afctol/31/
-c data dgnorm/1/, dinit/38/, dstnrm/2/, dst0/3/, f/10/, f0/13/,
-c 1 fdif/11/, gthg/44/, gtstep/4/, incfac/23/, lmat/42/,
-c 2 lmax0/35/, lmaxs/36/, nextv/47/, nreduc/6/, preduc/7/,
-c 3 radfac/16/, radius/8/, rad0/9/, reldx/17/, tuner4/29/,
-c 4 tuner5/30/
-c/7
- parameter (afctol=31)
- parameter (dgnorm=1, dinit=38, dstnrm=2, dst0=3, f=10, f0=13,
- 1 fdif=11, gthg=44, gtstep=4, incfac=23, lmat=42,
- 2 lmax0=35, lmaxs=36, nextv=47, nreduc=6, preduc=7,
- 3 radfac=16, radius=8, rad0=9, reldx=17, tuner4=29,
- 4 tuner5=30)
-c/
-c
-c/6
-c data half/0.5d+0/, negone/-1.d+0/, one/1.d+0/, onep2/1.2d+0/,
-c 1 zero/0.d+0/
-c/7
- parameter (half=0.5d+0, negone=-1.d+0, one=1.d+0, onep2=1.2d+0,
- 1 zero=0.d+0)
-c/
-c
-c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++
-c
-C Following SAVE statement inserted.
- save l
- i = iv(1)
- if (i .eq. 1) go to 50
- if (i .eq. 2) go to 60
-c
-c *** check validity of iv and v input values ***
-c
- if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v)
- if (iv(1) .eq. 12 .or. iv(1) .eq. 13)
- 1 iv(vneed) = iv(vneed) + n*(n+13)/2
- call parck(2, d, iv, liv, lv, n, v)
- i = iv(1) - 2
- if (i .gt. 12) go to 999
- go to (180, 180, 180, 180, 180, 180, 120, 90, 120, 10, 10, 20), i
-c
-c *** storage allocation ***
-c
-10 l = iv(lmat)
- iv(x0) = l + n*(n+1)/2
- iv(step) = iv(x0) + n
- iv(stlstg) = iv(step) + n
- iv(g0) = iv(stlstg) + n
- iv(nwtstp) = iv(g0) + n
- iv(dg) = iv(nwtstp) + n
- iv(nextv) = iv(dg) + n
- if (iv(1) .ne. 13) go to 20
- iv(1) = 14
- go to 999
-c
-c *** initialization ***
-c
- 20 iv(niter) = 0
- iv(nfcall) = 1
- iv(ngcall) = 1
- iv(nfgcal) = 1
- iv(mode) = -1
- iv(model) = 1
- iv(stglim) = 1
- iv(toobig) = 0
- iv(cnvcod) = 0
- iv(radinc) = 0
- v(rad0) = zero
- if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit))
- if (iv(inith) .ne. 1) go to 40
-c
-c *** set the initial hessian approximation to diag(d)**-2 ***
-c
- l = iv(lmat)
- call vscopy(n*(n+1)/2, v(l), zero)
- k = l - 1
- do 30 i = 1, n
- k = k + i
- t = d(i)
- if (t .le. zero) t = one
- v(k) = t
- 30 continue
-c
-c *** compute initial function value ***
-c
- 40 iv(1) = 1
- go to 999
-c
- 50 v(f) = fx
- if (iv(mode) .ge. 0) go to 180
- iv(1) = 2
- if (iv(toobig) .eq. 0) go to 999
- iv(1) = 63
- go to 300
-c
-c *** make sure gradient could be computed ***
-c
- 60 if (iv(nfgcal) .ne. 0) go to 70
- iv(1) = 65
- go to 300
-c
- 70 dg1 = iv(dg)
- call vvmulp(n, v(dg1), g, d, -1)
- v(dgnorm) = v2norm(n, v(dg1))
-c
-c *** test norm of gradient ***
-c
- if (v(dgnorm) .gt. v(afctol)) go to 75
- iv(irc) = 10
- iv(cnvcod) = iv(irc) - 4
-c
- 75 if (iv(cnvcod) .ne. 0) go to 290
- if (iv(mode) .eq. 0) go to 250
-c
-c *** allow first step to have scaled 2-norm at most v(lmax0) ***
-c
- v(radius) = v(lmax0)
-c
- iv(mode) = 0
-c
-c
-c----------------------------- main loop -----------------------------
-c
-c
-c *** print iteration summary, check iteration limit ***
-c
- 80 call itsum(d, g, iv, liv, lv, n, v, x)
- 90 k = iv(niter)
- if (k .lt. iv(mxiter)) go to 100
- iv(1) = 10
- go to 300
-c
-c *** update radius ***
-c
- 100 iv(niter) = k + 1
- if(k.gt.0)v(radius) = v(radfac) * v(dstnrm)
-c
-c *** initialize for start of next iteration ***
-c
- g01 = iv(g0)
- x01 = iv(x0)
- v(f0) = v(f)
- iv(irc) = 4
- iv(kagqt) = -1
-c
-c *** copy x to x0, g to g0 ***
-c
- call vcopy(n, v(x01), x)
- call vcopy(n, v(g01), g)
-c
-c *** check stopx and function evaluation limit ***
-c
-C AL 4/30/95
- dummy=iv(nfcall)
- 110 if (.not. stopx(dummy)) go to 130
- iv(1) = 11
- go to 140
-c
-c *** come here when restarting after func. eval. limit or stopx.
-c
- 120 if (v(f) .ge. v(f0)) go to 130
- v(radfac) = one
- k = iv(niter)
- go to 100
-c
- 130 if (iv(nfcall) .lt. iv(mxfcal)) go to 150
- iv(1) = 9
- 140 if (v(f) .ge. v(f0)) go to 300
-c
-c *** in case of stopx or function evaluation limit with
-c *** improved v(f), evaluate the gradient at x.
-c
- iv(cnvcod) = iv(1)
- go to 240
-c
-c. . . . . . . . . . . . . compute candidate step . . . . . . . . . .
-c
- 150 step1 = iv(step)
- dg1 = iv(dg)
- nwtst1 = iv(nwtstp)
- if (iv(kagqt) .ge. 0) go to 160
- l = iv(lmat)
- call livmul(n, v(nwtst1), v(l), g)
- v(nreduc) = half * dotprd(n, v(nwtst1), v(nwtst1))
- call litvmu(n, v(nwtst1), v(l), v(nwtst1))
- call vvmulp(n, v(step1), v(nwtst1), d, 1)
- v(dst0) = v2norm(n, v(step1))
- call vvmulp(n, v(dg1), v(dg1), d, -1)
- call ltvmul(n, v(step1), v(l), v(dg1))
- v(gthg) = v2norm(n, v(step1))
- iv(kagqt) = 0
- 160 call dbdog(v(dg1), lv, n, v(nwtst1), v(step1), v)
- if (iv(irc) .eq. 6) go to 180
-c
-c *** check whether evaluating f(x0 + step) looks worthwhile ***
-c
- if (v(dstnrm) .le. zero) go to 180
- if (iv(irc) .ne. 5) go to 170
- if (v(radfac) .le. one) go to 170
- if (v(preduc) .le. onep2 * v(fdif)) go to 180
-c
-c *** compute f(x0 + step) ***
-c
- 170 x01 = iv(x0)
- step1 = iv(step)
- call vaxpy(n, x, one, v(step1), v(x01))
- iv(nfcall) = iv(nfcall) + 1
- iv(1) = 1
- iv(toobig) = 0
- go to 999
-c
-c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . .
-c
- 180 x01 = iv(x0)
- v(reldx) = reldst(n, d, x, v(x01))
- call assst(iv, liv, lv, v)
- step1 = iv(step)
- lstgst = iv(stlstg)
- if (iv(restor) .eq. 1) call vcopy(n, x, v(x01))
- if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1))
- if (iv(restor) .ne. 3) go to 190
- call vcopy(n, v(step1), v(lstgst))
- call vaxpy(n, x, one, v(step1), v(x01))
- v(reldx) = reldst(n, d, x, v(x01))
-c
- 190 k = iv(irc)
- go to (200,230,230,230,200,210,220,220,220,220,220,220,280,250), k
-c
-c *** recompute step with changed radius ***
-c
- 200 v(radius) = v(radfac) * v(dstnrm)
- go to 110
-c
-c *** compute step of length v(lmaxs) for singular convergence test.
-c
- 210 v(radius) = v(lmaxs)
- go to 150
-c
-c *** convergence or false convergence ***
-c
- 220 iv(cnvcod) = k - 4
- if (v(f) .ge. v(f0)) go to 290
- if (iv(xirc) .eq. 14) go to 290
- iv(xirc) = 14
-c
-c. . . . . . . . . . . . process acceptable step . . . . . . . . . . .
-c
- 230 if (iv(irc) .ne. 3) go to 240
- step1 = iv(step)
- temp1 = iv(stlstg)
-c
-c *** set temp1 = hessian * step for use in gradient tests ***
-c
- l = iv(lmat)
- call ltvmul(n, v(temp1), v(l), v(step1))
- call lvmul(n, v(temp1), v(l), v(temp1))
-c
-c *** compute gradient ***
-c
- 240 iv(ngcall) = iv(ngcall) + 1
- iv(1) = 2
- go to 999
-c
-c *** initializations -- g0 = g - g0, etc. ***
-c
- 250 g01 = iv(g0)
- call vaxpy(n, v(g01), negone, v(g01), g)
- step1 = iv(step)
- temp1 = iv(stlstg)
- if (iv(irc) .ne. 3) go to 270
-c
-c *** set v(radfac) by gradient tests ***
-c
-c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) ***
-c
- call vaxpy(n, v(temp1), negone, v(g01), v(temp1))
- call vvmulp(n, v(temp1), v(temp1), d, -1)
-c
-c *** do gradient tests ***
-c
- if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4))
- 1 go to 260
- if (dotprd(n, g, v(step1))
- 1 .ge. v(gtstep) * v(tuner5)) go to 270
- 260 v(radfac) = v(incfac)
-c
-c *** update h, loop ***
-c
- 270 w = iv(nwtstp)
- z = iv(x0)
- l = iv(lmat)
- call wzbfgs(v(l), n, v(step1), v(w), v(g01), v(z))
-c
-c ** use the n-vectors starting at v(step1) and v(g01) for scratch..
- call lupdat(v(temp1), v(step1), v(l), v(g01), v(l), n, v(w), v(z))
- iv(1) = 2
- go to 80
-c
-c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . .
-c
-c *** bad parameters to assess ***
-c
- 280 iv(1) = 64
- go to 300
-c
-c *** print summary of final iteration and other requested items ***
-c
- 290 iv(1) = iv(cnvcod)
- iv(cnvcod) = 0
- 300 call itsum(d, g, iv, liv, lv, n, v, x)
-c
- 999 return
-c
-c *** last line of sumit follows ***
- end
- subroutine dbdog(dig, lv, n, nwtstp, step, v)
-c
-c *** compute double dogleg step ***
-c
-c *** parameter declarations ***
-c
- integer lv, n
- double precision dig(n), nwtstp(n), step(n), v(lv)
-c
-c *** purpose ***
-c
-c this subroutine computes a candidate step (for use in an uncon-
-c strained minimization code) by the double dogleg algorithm of
-c dennis and mei (ref. 1), which is a variation on powell*s dogleg
-c scheme (ref. 2, p. 95).
-c
-c-------------------------- parameter usage --------------------------
-c
-c dig (input) diag(d)**-2 * g -- see algorithm notes.
-c g (input) the current gradient vector.
-c lv (input) length of v.
-c n (input) number of components in dig, g, nwtstp, and step.
-c nwtstp (input) negative newton step -- see algorithm notes.
-c step (output) the computed step.
-c v (i/o) values array, the following components of which are
-c used here...
-c v(bias) (input) bias for relaxed newton step, which is v(bias) of
-c the way from the full newton to the fully relaxed newton
-c step. recommended value = 0.8 .
-c v(dgnorm) (input) 2-norm of diag(d)**-1 * g -- see algorithm notes.
-c v(dstnrm) (output) 2-norm of diag(d) * step, which is v(radius)
-c unless v(stppar) = 0 -- see algorithm notes.
-c v(dst0) (input) 2-norm of diag(d) * nwtstp -- see algorithm notes.
-c v(grdfac) (output) the coefficient of dig in the step returned --
-c step(i) = v(grdfac)*dig(i) + v(nwtfac)*nwtstp(i).
-c v(gthg) (input) square-root of (dig**t) * (hessian) * dig -- see
-c algorithm notes.
-c v(gtstep) (output) inner product between g and step.
-c v(nreduc) (output) function reduction predicted for the full newton
-c step.
-c v(nwtfac) (output) the coefficient of nwtstp in the step returned --
-c see v(grdfac) above.
-c v(preduc) (output) function reduction predicted for the step returned.
-c v(radius) (input) the trust region radius. d times the step returned
-c has 2-norm v(radius) unless v(stppar) = 0.
-c v(stppar) (output) code telling how step was computed... 0 means a
-c full newton step. between 0 and 1 means v(stppar) of the
-c way from the newton to the relaxed newton step. between
-c 1 and 2 means a true double dogleg step, v(stppar) - 1 of
-c the way from the relaxed newton to the cauchy step.
-c greater than 2 means 1 / (v(stppar) - 1) times the cauchy
-c step.
-c
-c------------------------------- notes -------------------------------
-c
-c *** algorithm notes ***
-c
-c let g and h be the current gradient and hessian approxima-
-c tion respectively and let d be the current scale vector. this
-c routine assumes dig = diag(d)**-2 * g and nwtstp = h**-1 * g.
-c the step computed is the same one would get by replacing g and h
-c by diag(d)**-1 * g and diag(d)**-1 * h * diag(d)**-1,
-c computing step, and translating step back to the original
-c variables, i.e., premultiplying it by diag(d)**-1.
-c
-c *** references ***
-c
-c 1. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti-
-c mization algorithms which use function and gradient
-c values, j. optim. theory applic. 28, pp. 453-482.
-c 2. powell, m.j.d. (1970), a hybrid method for non-linear equations,
-c in numerical methods for non-linear equations, edited by
-c p. rabinowitz, gordon and breach, london.
-c
-c *** general ***
-c
-c coded by david m. gay.
-c this subroutine was written in connection with research supported
-c by the national science foundation under grants mcs-7600324 and
-c mcs-7906671.
-c
-c------------------------ external quantities ------------------------
-c
-c *** functions and subroutines called ***
-c
- external dotprd, v2norm
- double precision dotprd, v2norm
-c
-c dotprd... returns inner product of two vectors.
-c v2norm... returns 2-norm of a vector.
-c
-c *** intrinsic functions ***
-c/+
- double precision dsqrt
-c/
-c-------------------------- local variables --------------------------
-c
- integer i
- double precision cfact, cnorm, ctrnwt, ghinvg, femnsq, gnorm,
- 1 nwtnrm, relax, rlambd, t, t1, t2
- double precision half, one, two, zero
-c
-c *** v subscripts ***
-c
- integer bias, dgnorm, dstnrm, dst0, grdfac, gthg, gtstep,
- 1 nreduc, nwtfac, preduc, radius, stppar
-c
-c *** data initializations ***
-c
-c/6
-c data half/0.5d+0/, one/1.d+0/, two/2.d+0/, zero/0.d+0/
-c/7
- parameter (half=0.5d+0, one=1.d+0, two=2.d+0, zero=0.d+0)
-c/
-c
-c/6
-c data bias/43/, dgnorm/1/, dstnrm/2/, dst0/3/, grdfac/45/,
-c 1 gthg/44/, gtstep/4/, nreduc/6/, nwtfac/46/, preduc/7/,
-c 2 radius/8/, stppar/5/
-c/7
- parameter (bias=43, dgnorm=1, dstnrm=2, dst0=3, grdfac=45,
- 1 gthg=44, gtstep=4, nreduc=6, nwtfac=46, preduc=7,
- 2 radius=8, stppar=5)
-c/
-c
-c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++
-c
- nwtnrm = v(dst0)
- rlambd = one
- if (nwtnrm .gt. zero) rlambd = v(radius) / nwtnrm
- gnorm = v(dgnorm)
- ghinvg = two * v(nreduc)
- v(grdfac) = zero
- v(nwtfac) = zero
- if (rlambd .lt. one) go to 30
-c
-c *** the newton step is inside the trust region ***
-c
- v(stppar) = zero
- v(dstnrm) = nwtnrm
- v(gtstep) = -ghinvg
- v(preduc) = v(nreduc)
- v(nwtfac) = -one
- do 20 i = 1, n
- 20 step(i) = -nwtstp(i)
- go to 999
-c
- 30 v(dstnrm) = v(radius)
- cfact = (gnorm / v(gthg))**2
-c *** cauchy step = -cfact * g.
- cnorm = gnorm * cfact
- relax = one - v(bias) * (one - gnorm*cnorm/ghinvg)
- if (rlambd .lt. relax) go to 50
-c
-c *** step is between relaxed newton and full newton steps ***
-c
- v(stppar) = one - (rlambd - relax) / (one - relax)
- t = -rlambd
- v(gtstep) = t * ghinvg
- v(preduc) = rlambd * (one - half*rlambd) * ghinvg
- v(nwtfac) = t
- do 40 i = 1, n
- 40 step(i) = t * nwtstp(i)
- go to 999
-c
- 50 if (cnorm .lt. v(radius)) go to 70
-c
-c *** the cauchy step lies outside the trust region --
-c *** step = scaled cauchy step ***
-c
- t = -v(radius) / gnorm
- v(grdfac) = t
- v(stppar) = one + cnorm / v(radius)
- v(gtstep) = -v(radius) * gnorm
- v(preduc) = v(radius)*(gnorm - half*v(radius)*(v(gthg)/gnorm)**2)
- do 60 i = 1, n
- 60 step(i) = t * dig(i)
- go to 999
-c
-c *** compute dogleg step between cauchy and relaxed newton ***
-c *** femur = relaxed newton step minus cauchy step ***
-c
- 70 ctrnwt = cfact * relax * ghinvg / gnorm
-c *** ctrnwt = inner prod. of cauchy and relaxed newton steps,
-c *** scaled by gnorm**-1.
- t1 = ctrnwt - gnorm*cfact**2
-c *** t1 = inner prod. of femur and cauchy step, scaled by
-c *** gnorm**-1.
- t2 = v(radius)*(v(radius)/gnorm) - gnorm*cfact**2
- t = relax * nwtnrm
- femnsq = (t/gnorm)*t - ctrnwt - t1
-c *** femnsq = square of 2-norm of femur, scaled by gnorm**-1.
- t = t2 / (t1 + dsqrt(t1**2 + femnsq*t2))
-c *** dogleg step = cauchy step + t * femur.
- t1 = (t - one) * cfact
- v(grdfac) = t1
- t2 = -t * relax
- v(nwtfac) = t2
- v(stppar) = two - t
- v(gtstep) = t1*gnorm**2 + t2*ghinvg
- v(preduc) = -t1*gnorm * ((t2 + one)*gnorm)
- 1 - t2 * (one + half*t2)*ghinvg
- 2 - half * (v(gthg)*t1)**2
- do 80 i = 1, n
- 80 step(i) = t1*dig(i) + t2*nwtstp(i)
-c
- 999 return
-c *** last line of dbdog follows ***
- end
- subroutine ltvmul(n, x, l, y)
-c
-c *** compute x = (l**t)*y, where l is an n x n lower
-c *** triangular matrix stored compactly by rows. x and y may
-c *** occupy the same storage. ***
-c
- integer n
-cal double precision x(n), l(1), y(n)
- double precision x(n), l(n*(n+1)/2), y(n)
-c dimension l(n*(n+1)/2)
- integer i, ij, i0, j
- double precision yi, zero
-c/6
-c data zero/0.d+0/
-c/7
- parameter (zero=0.d+0)
-c/
-c
- i0 = 0
- do 20 i = 1, n
- yi = y(i)
- x(i) = zero
- do 10 j = 1, i
- ij = i0 + j
- x(j) = x(j) + yi*l(ij)
- 10 continue
- i0 = i0 + i
- 20 continue
- 999 return
-c *** last card of ltvmul follows ***
- end
- subroutine lupdat(beta, gamma, l, lambda, lplus, n, w, z)
-c
-c *** compute lplus = secant update of l ***
-c
-c *** parameter declarations ***
-c
- integer n
-cal double precision beta(n), gamma(n), l(1), lambda(n), lplus(1),
- double precision beta(n), gamma(n), l(n*(n+1)/2), lambda(n),
- 1 lplus(n*(n+1)/2),w(n), z(n)
-c dimension l(n*(n+1)/2), lplus(n*(n+1)/2)
-c
-c-------------------------- parameter usage --------------------------
-c
-c beta = scratch vector.
-c gamma = scratch vector.
-c l (input) lower triangular matrix, stored rowwise.
-c lambda = scratch vector.
-c lplus (output) lower triangular matrix, stored rowwise, which may
-c occupy the same storage as l.
-c n (input) length of vector parameters and order of matrices.
-c w (input, destroyed on output) right singular vector of rank 1
-c correction to l.
-c z (input, destroyed on output) left singular vector of rank 1
-c correction to l.
-c
-c------------------------------- notes -------------------------------
-c
-c *** application and usage restrictions ***
-c
-c this routine updates the cholesky factor l of a symmetric
-c positive definite matrix to which a secant update is being
-c applied -- it computes a cholesky factor lplus of
-c l * (i + z*w**t) * (i + w*z**t) * l**t. it is assumed that w
-c and z have been chosen so that the updated matrix is strictly
-c positive definite.
-c
-c *** algorithm notes ***
-c
-c this code uses recurrence 3 of ref. 1 (with d(j) = 1 for all j)
-c to compute lplus of the form l * (i + z*w**t) * q, where q
-c is an orthogonal matrix that makes the result lower triangular.
-c lplus may have some negative diagonal elements.
-c
-c *** references ***
-c
-c 1. goldfarb, d. (1976), factorized variable metric methods for uncon-
-c strained optimization, math. comput. 30, pp. 796-811.
-c
-c *** general ***
-c
-c coded by david m. gay (fall 1979).
-c this subroutine was written in connection with research supported
-c by the national science foundation under grants mcs-7600324 and
-c mcs-7906671.
-c
-c------------------------ external quantities ------------------------
-c
-c *** intrinsic functions ***
-c/+
- double precision dsqrt
-c/
-c-------------------------- local variables --------------------------
-c
- integer i, ij, j, jj, jp1, k, nm1, np1
- double precision a, b, bj, eta, gj, lj, lij, ljj, nu, s, theta,
- 1 wj, zj
- double precision one, zero
-c
-c *** data initializations ***
-c
-c/6
-c data one/1.d+0/, zero/0.d+0/
-c/7
- parameter (one=1.d+0, zero=0.d+0)
-c/
-c
-c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++
-c
- nu = one
- eta = zero
- if (n .le. 1) go to 30
- nm1 = n - 1
-c
-c *** temporarily store s(j) = sum over k = j+1 to n of w(k)**2 in
-c *** lambda(j).
-c
- s = zero
- do 10 i = 1, nm1
- j = n - i
- s = s + w(j+1)**2
- lambda(j) = s
- 10 continue
-c
-c *** compute lambda, gamma, and beta by goldfarb*s recurrence 3.
-c
- do 20 j = 1, nm1
- wj = w(j)
- a = nu*z(j) - eta*wj
- theta = one + a*wj
- s = a*lambda(j)
- lj = dsqrt(theta**2 + a*s)
- if (theta .gt. zero) lj = -lj
- lambda(j) = lj
- b = theta*wj + s
- gamma(j) = b * nu / lj
- beta(j) = (a - b*eta) / lj
- nu = -nu / lj
- eta = -(eta + (a**2)/(theta - lj)) / lj
- 20 continue
- 30 lambda(n) = one + (nu*z(n) - eta*w(n))*w(n)
-c
-c *** update l, gradually overwriting w and z with l*w and l*z.
-c
- np1 = n + 1
- jj = n * (n + 1) / 2
- do 60 k = 1, n
- j = np1 - k
- lj = lambda(j)
- ljj = l(jj)
- lplus(jj) = lj * ljj
- wj = w(j)
- w(j) = ljj * wj
- zj = z(j)
- z(j) = ljj * zj
- if (k .eq. 1) go to 50
- bj = beta(j)
- gj = gamma(j)
- ij = jj + j
- jp1 = j + 1
- do 40 i = jp1, n
- lij = l(ij)
- lplus(ij) = lj*lij + bj*w(i) + gj*z(i)
- w(i) = w(i) + lij*wj
- z(i) = z(i) + lij*zj
- ij = ij + i
- 40 continue
- 50 jj = jj - j
- 60 continue
-c
- 999 return
-c *** last card of lupdat follows ***
- end
- subroutine lvmul(n, x, l, y)
-c
-c *** compute x = l*y, where l is an n x n lower triangular
-c *** matrix stored compactly by rows. x and y may occupy the same
-c *** storage. ***
-c
- integer n
-cal double precision x(n), l(1), y(n)
- double precision x(n), l(n*(n+1)/2), y(n)
-c dimension l(n*(n+1)/2)
- integer i, ii, ij, i0, j, np1
- double precision t, zero
-c/6
-c data zero/0.d+0/
-c/7
- parameter (zero=0.d+0)
-c/
-c
- np1 = n + 1
- i0 = n*(n+1)/2
- do 20 ii = 1, n
- i = np1 - ii
- i0 = i0 - i
- t = zero
- do 10 j = 1, i
- ij = i0 + j
- t = t + l(ij)*y(j)
- 10 continue
- x(i) = t
- 20 continue
- 999 return
-c *** last card of lvmul follows ***
- end
- subroutine vvmulp(n, x, y, z, k)
-c
-c *** set x(i) = y(i) * z(i)**k, 1 .le. i .le. n (for k = 1 or -1) ***
-c
- integer n, k
- double precision x(n), y(n), z(n)
- integer i
-c
- if (k .ge. 0) go to 20
- do 10 i = 1, n
- 10 x(i) = y(i) / z(i)
- go to 999
-c
- 20 do 30 i = 1, n
- 30 x(i) = y(i) * z(i)
- 999 return
-c *** last card of vvmulp follows ***
- end
- subroutine wzbfgs (l, n, s, w, y, z)
-c
-c *** compute y and z for lupdat corresponding to bfgs update.
-c
- integer n
-cal double precision l(1), s(n), w(n), y(n), z(n)
- double precision l(n*(n+1)/2), s(n), w(n), y(n), z(n)
-c dimension l(n*(n+1)/2)
-c
-c-------------------------- parameter usage --------------------------
-c
-c l (i/o) cholesky factor of hessian, a lower triang. matrix stored
-c compactly by rows.
-c n (input) order of l and length of s, w, y, z.
-c s (input) the step just taken.
-c w (output) right singular vector of rank 1 correction to l.
-c y (input) change in gradients corresponding to s.
-c z (output) left singular vector of rank 1 correction to l.
-c
-c------------------------------- notes -------------------------------
-c
-c *** algorithm notes ***
-c
-c when s is computed in certain ways, e.g. by gqtstp or
-c dbldog, it is possible to save n**2/2 operations since (l**t)*s
-c or l*(l**t)*s is then known.
-c if the bfgs update to l*(l**t) would reduce its determinant to
-c less than eps times its old value, then this routine in effect
-c replaces y by theta*y + (1 - theta)*l*(l**t)*s, where theta
-c (between 0 and 1) is chosen to make the reduction factor = eps.
-c
-c *** general ***
-c
-c coded by david m. gay (fall 1979).
-c this subroutine was written in connection with research supported
-c by the national science foundation under grants mcs-7600324 and
-c mcs-7906671.
-c
-c------------------------ external quantities ------------------------
-c
-c *** functions and subroutines called ***
-c
- external dotprd, livmul, ltvmul
- double precision dotprd
-c dotprd returns inner product of two vectors.
-c livmul multiplies l**-1 times a vector.
-c ltvmul multiplies l**t times a vector.
-c
-c *** intrinsic functions ***
-c/+
- double precision dsqrt
-c/
-c-------------------------- local variables --------------------------
-c
- integer i
- double precision cs, cy, eps, epsrt, one, shs, ys, theta
-c
-c *** data initializations ***
-c
-c/6
-c data eps/0.1d+0/, one/1.d+0/
-c/7
- parameter (eps=0.1d+0, one=1.d+0)
-c/
-c
-c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++
-c
- call ltvmul(n, w, l, s)
- shs = dotprd(n, w, w)
- ys = dotprd(n, y, s)
- if (ys .ge. eps*shs) go to 10
- theta = (one - eps) * shs / (shs - ys)
- epsrt = dsqrt(eps)
- cy = theta / (shs * epsrt)
- cs = (one + (theta-one)/epsrt) / shs
- go to 20
- 10 cy = one / (dsqrt(ys) * dsqrt(shs))
- cs = one / shs
- 20 call livmul(n, z, l, y)
- do 30 i = 1, n
- 30 z(i) = cy * z(i) - cs * w(i)
-c
- 999 return
-c *** last card of wzbfgs follows ***
- end
+++ /dev/null
-c
-c
-c ###################################################
-c ## COPYRIGHT (C) 1996 by Jay William Ponder ##
-c ## All Rights Reserved ##
-c ###################################################
-c
-c ################################################################
-c ## ##
-c ## subroutine surfatom -- exposed surface area of an atom ##
-c ## ##
-c ################################################################
-c
-c
-c "surfatom" performs an analytical computation of the surface
-c area of a specified atom; a simplified version of "surface"
-c
-c literature references:
-c
-c T. J. Richmond, "Solvent Accessible Surface Area and
-c Excluded Volume in Proteins", Journal of Molecular Biology,
-c 178, 63-89 (1984)
-c
-c L. Wesson and D. Eisenberg, "Atomic Solvation Parameters
-c Applied to Molecular Dynamics of Proteins in Solution",
-c Protein Science, 1, 227-235 (1992)
-c
-c variables and parameters:
-c
-c ir number of atom for which area is desired
-c area accessible surface area of the atom
-c radius radii of each of the individual atoms
-c
-c
- subroutine surfatom (ir,area,radius)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'sizes.i'
- include 'COMMON.GEO'
- include 'COMMON.IOUNITS'
- integer nres,nsup,nstart_sup
- double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm
- common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2),
- & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2),
- & dc_work(MAXRES6),nres,nres0
- integer maxarc
- parameter (maxarc=300)
- integer i,j,k,m
- integer ii,ib,jb
- integer io,ir
- integer mi,ni,narc
- integer key(maxarc)
- integer intag(maxarc)
- integer intag1(maxarc)
- real*8 area,arcsum
- real*8 arclen,exang
- real*8 delta,delta2
- real*8 eps,rmove
- real*8 xr,yr,zr
- real*8 rr,rrsq
- real*8 rplus,rminus
- real*8 axx,axy,axz
- real*8 ayx,ayy
- real*8 azx,azy,azz
- real*8 uxj,uyj,uzj
- real*8 tx,ty,tz
- real*8 txb,tyb,td
- real*8 tr2,tr,txr,tyr
- real*8 tk1,tk2
- real*8 thec,the,t,tb
- real*8 txk,tyk,tzk
- real*8 t1,ti,tf,tt
- real*8 txj,tyj,tzj
- real*8 ccsq,cc,xysq
- real*8 bsqk,bk,cosine
- real*8 dsqj,gi,pix2
- real*8 therk,dk,gk
- real*8 risqk,rik
- real*8 radius(maxatm)
- real*8 ri(maxarc),risq(maxarc)
- real*8 ux(maxarc),uy(maxarc),uz(maxarc)
- real*8 xc(maxarc),yc(maxarc),zc(maxarc)
- real*8 xc1(maxarc),yc1(maxarc),zc1(maxarc)
- real*8 dsq(maxarc),bsq(maxarc)
- real*8 dsq1(maxarc),bsq1(maxarc)
- real*8 arci(maxarc),arcf(maxarc)
- real*8 ex(maxarc),lt(maxarc),gr(maxarc)
- real*8 b(maxarc),b1(maxarc),bg(maxarc)
- real*8 kent(maxarc),kout(maxarc)
- real*8 ther(maxarc)
- logical moved,top
- logical omit(maxarc)
-c
-c
-c zero out the surface area for the sphere of interest
-c
- area = 0.0d0
-c write (2,*) "ir",ir," radius",radius(ir)
- if (radius(ir) .eq. 0.0d0) return
-c
-c set the overlap significance and connectivity shift
-c
- pix2 = 2.0d0 * pi
- delta = 1.0d-8
- delta2 = delta * delta
- eps = 1.0d-8
- moved = .false.
- rmove = 1.0d-8
-c
-c store coordinates and radius of the sphere of interest
-c
- xr = c(1,ir)
- yr = c(2,ir)
- zr = c(3,ir)
- rr = radius(ir)
- rrsq = rr * rr
-c
-c initialize values of some counters and summations
-c
- 10 continue
- io = 0
- jb = 0
- ib = 0
- arclen = 0.0d0
- exang = 0.0d0
-c
-c test each sphere to see if it overlaps the sphere of interest
-c
- do i = 1, 2*nres
- if (i.eq.ir .or. radius(i).eq.0.0d0) goto 30
- rplus = rr + radius(i)
- tx = c(1,i) - xr
- if (abs(tx) .ge. rplus) goto 30
- ty = c(2,i) - yr
- if (abs(ty) .ge. rplus) goto 30
- tz = c(3,i) - zr
- if (abs(tz) .ge. rplus) goto 30
-c
-c check for sphere overlap by testing distance against radii
-c
- xysq = tx*tx + ty*ty
- if (xysq .lt. delta2) then
- tx = delta
- ty = 0.0d0
- xysq = delta2
- end if
- ccsq = xysq + tz*tz
- cc = sqrt(ccsq)
- if (rplus-cc .le. delta) goto 30
- rminus = rr - radius(i)
-c
-c check to see if sphere of interest is completely buried
-c
- if (cc-abs(rminus) .le. delta) then
- if (rminus .le. 0.0d0) goto 170
- goto 30
- end if
-c
-c check for too many overlaps with sphere of interest
-c
- if (io .ge. maxarc) then
- write (iout,20)
- 20 format (/,' SURFATOM -- Increase the Value of MAXARC')
- stop
- end if
-c
-c get overlap between current sphere and sphere of interest
-c
- io = io + 1
- xc1(io) = tx
- yc1(io) = ty
- zc1(io) = tz
- dsq1(io) = xysq
- bsq1(io) = ccsq
- b1(io) = cc
- gr(io) = (ccsq+rplus*rminus) / (2.0d0*rr*b1(io))
- intag1(io) = i
- omit(io) = .false.
- 30 continue
- end do
-c
-c case where no other spheres overlap the sphere of interest
-c
- if (io .eq. 0) then
- area = 4.0d0 * pi * rrsq
- return
- end if
-c
-c case where only one sphere overlaps the sphere of interest
-c
- if (io .eq. 1) then
- area = pix2 * (1.0d0 + gr(1))
- area = mod(area,4.0d0*pi) * rrsq
- return
- end if
-c
-c case where many spheres intersect the sphere of interest;
-c sort the intersecting spheres by their degree of overlap
-c
- call sort2 (io,gr,key)
- do i = 1, io
- k = key(i)
- intag(i) = intag1(k)
- xc(i) = xc1(k)
- yc(i) = yc1(k)
- zc(i) = zc1(k)
- dsq(i) = dsq1(k)
- b(i) = b1(k)
- bsq(i) = bsq1(k)
- end do
-c
-c get radius of each overlap circle on surface of the sphere
-c
- do i = 1, io
- gi = gr(i) * rr
- bg(i) = b(i) * gi
- risq(i) = rrsq - gi*gi
- ri(i) = sqrt(risq(i))
- ther(i) = 0.5d0*pi - asin(min(1.0d0,max(-1.0d0,gr(i))))
- end do
-c
-c find boundary of inaccessible area on sphere of interest
-c
- do k = 1, io-1
- if (.not. omit(k)) then
- txk = xc(k)
- tyk = yc(k)
- tzk = zc(k)
- bk = b(k)
- therk = ther(k)
-c
-c check to see if J circle is intersecting K circle;
-c get distance between circle centers and sum of radii
-c
- do j = k+1, io
- if (omit(j)) goto 60
- cc = (txk*xc(j)+tyk*yc(j)+tzk*zc(j))/(bk*b(j))
- cc = acos(min(1.0d0,max(-1.0d0,cc)))
- td = therk + ther(j)
-c
-c check to see if circles enclose separate regions
-c
- if (cc .ge. td) goto 60
-c
-c check for circle J completely inside circle K
-c
- if (cc+ther(j) .lt. therk) goto 40
-c
-c check for circles that are essentially parallel
-c
- if (cc .gt. delta) goto 50
- 40 continue
- omit(j) = .true.
- goto 60
-c
-c check to see if sphere of interest is completely buried
-c
- 50 continue
- if (pix2-cc .le. td) goto 170
- 60 continue
- end do
- end if
- end do
-c
-c find T value of circle intersections
-c
- do k = 1, io
- if (omit(k)) goto 110
- omit(k) = .true.
- narc = 0
- top = .false.
- txk = xc(k)
- tyk = yc(k)
- tzk = zc(k)
- dk = sqrt(dsq(k))
- bsqk = bsq(k)
- bk = b(k)
- gk = gr(k) * rr
- risqk = risq(k)
- rik = ri(k)
- therk = ther(k)
-c
-c rotation matrix elements
-c
- t1 = tzk / (bk*dk)
- axx = txk * t1
- axy = tyk * t1
- axz = dk / bk
- ayx = tyk / dk
- ayy = txk / dk
- azx = txk / bk
- azy = tyk / bk
- azz = tzk / bk
- do j = 1, io
- if (.not. omit(j)) then
- txj = xc(j)
- tyj = yc(j)
- tzj = zc(j)
-c
-c rotate spheres so K vector colinear with z-axis
-c
- uxj = txj*axx + tyj*axy - tzj*axz
- uyj = tyj*ayy - txj*ayx
- uzj = txj*azx + tyj*azy + tzj*azz
- cosine = min(1.0d0,max(-1.0d0,uzj/b(j)))
- if (acos(cosine) .lt. therk+ther(j)) then
- dsqj = uxj*uxj + uyj*uyj
- tb = uzj*gk - bg(j)
- txb = uxj * tb
- tyb = uyj * tb
- td = rik * dsqj
- tr2 = risqk*dsqj - tb*tb
- tr2 = max(eps,tr2)
- tr = sqrt(tr2)
- txr = uxj * tr
- tyr = uyj * tr
-c
-c get T values of intersection for K circle
-c
- tb = (txb+tyr) / td
- tb = min(1.0d0,max(-1.0d0,tb))
- tk1 = acos(tb)
- if (tyb-txr .lt. 0.0d0) tk1 = pix2 - tk1
- tb = (txb-tyr) / td
- tb = min(1.0d0,max(-1.0d0,tb))
- tk2 = acos(tb)
- if (tyb+txr .lt. 0.0d0) tk2 = pix2 - tk2
- thec = (rrsq*uzj-gk*bg(j)) / (rik*ri(j)*b(j))
- if (abs(thec) .lt. 1.0d0) then
- the = -acos(thec)
- else if (thec .ge. 1.0d0) then
- the = 0.0d0
- else if (thec .le. -1.0d0) then
- the = -pi
- end if
-c
-c see if "tk1" is entry or exit point; check t=0 point;
-c "ti" is exit point, "tf" is entry point
-c
- cosine = min(1.0d0,max(-1.0d0,
- & (uzj*gk-uxj*rik)/(b(j)*rr)))
- if ((acos(cosine)-ther(j))*(tk2-tk1) .le. 0.0d0) then
- ti = tk2
- tf = tk1
- else
- ti = tk2
- tf = tk1
- end if
- narc = narc + 1
- if (narc .ge. maxarc) then
- write (iout,70)
- 70 format (/,' SURFATOM -- Increase the Value',
- & ' of MAXARC')
- stop
- end if
- if (tf .le. ti) then
- arcf(narc) = tf
- arci(narc) = 0.0d0
- tf = pix2
- lt(narc) = j
- ex(narc) = the
- top = .true.
- narc = narc + 1
- end if
- arcf(narc) = tf
- arci(narc) = ti
- lt(narc) = j
- ex(narc) = the
- ux(j) = uxj
- uy(j) = uyj
- uz(j) = uzj
- end if
- end if
- end do
- omit(k) = .false.
-c
-c special case; K circle without intersections
-c
- if (narc .le. 0) goto 90
-c
-c general case; sum up arclength and set connectivity code
-c
- call sort2 (narc,arci,key)
- arcsum = arci(1)
- mi = key(1)
- t = arcf(mi)
- ni = mi
- if (narc .gt. 1) then
- do j = 2, narc
- m = key(j)
- if (t .lt. arci(j)) then
- arcsum = arcsum + arci(j) - t
- exang = exang + ex(ni)
- jb = jb + 1
- if (jb .ge. maxarc) then
- write (iout,80)
- 80 format (/,' SURFATOM -- Increase the Value',
- & ' of MAXARC')
- stop
- end if
- i = lt(ni)
- kent(jb) = maxarc*i + k
- i = lt(m)
- kout(jb) = maxarc*k + i
- end if
- tt = arcf(m)
- if (tt .ge. t) then
- t = tt
- ni = m
- end if
- end do
- end if
- arcsum = arcsum + pix2 - t
- if (.not. top) then
- exang = exang + ex(ni)
- jb = jb + 1
- i = lt(ni)
- kent(jb) = maxarc*i + k
- i = lt(mi)
- kout(jb) = maxarc*k + i
- end if
- goto 100
- 90 continue
- arcsum = pix2
- ib = ib + 1
- 100 continue
- arclen = arclen + gr(k)*arcsum
- 110 continue
- end do
- if (arclen .eq. 0.0d0) goto 170
- if (jb .eq. 0) goto 150
-c
-c find number of independent boundaries and check connectivity
-c
- j = 0
- do k = 1, jb
- if (kout(k) .ne. 0) then
- i = k
- 120 continue
- m = kout(i)
- kout(i) = 0
- j = j + 1
- do ii = 1, jb
- if (m .eq. kent(ii)) then
- if (ii .eq. k) then
- ib = ib + 1
- if (j .eq. jb) goto 150
- goto 130
- end if
- i = ii
- goto 120
- end if
- end do
- 130 continue
- end if
- end do
- ib = ib + 1
-c
-c attempt to fix connectivity error by moving atom slightly
-c
- if (moved) then
- write (iout,140) ir
- 140 format (/,' SURFATOM -- Connectivity Error at Atom',i6)
- else
- moved = .true.
- xr = xr + rmove
- yr = yr + rmove
- zr = zr + rmove
- goto 10
- end if
-c
-c compute the exposed surface area for the sphere of interest
-c
- 150 continue
- area = ib*pix2 + exang + arclen
- area = mod(area,4.0d0*pi) * rrsq
-c
-c attempt to fix negative area by moving atom slightly
-c
- if (area .lt. 0.0d0) then
- if (moved) then
- write (iout,160) ir
- 160 format (/,' SURFATOM -- Negative Area at Atom',i6)
- else
- moved = .true.
- xr = xr + rmove
- yr = yr + rmove
- zr = zr + rmove
- goto 10
- end if
- end if
- 170 continue
- return
- end
+++ /dev/null
- subroutine test
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
- include 'COMMON.SBRIDGE'
- include 'COMMON.CONTROL'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
- include 'COMMON.CHAIN'
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision var(maxvar),var1(maxvar)
- integer j1,j2
- logical debug,accepted
- debug=.true.
-
-
- call geom_to_var(nvar,var1)
- call chainbuild
- call etotal(energy(0))
- etot=energy(0)
- call rmsd(rms)
- write(iout,*) 'etot=',0,etot,rms
- call secondary2(.false.)
-
- call write_pdb(0,'first structure',etot)
-
- j1=13
- j2=21
- da=180.0*deg2rad
-
-
-
- temp=3000.0d0
- betbol=1.0D0/(1.9858D-3*temp)
- jr=iran_num(j1,j2)
- d=ran_number(-pi,pi)
-c phi(jr)=pinorm(phi(jr)+d)
- call chainbuild
- call etotal(energy(0))
- etot0=energy(0)
- call rmsd(rms)
- write(iout,*) 'etot=',1,etot0,rms
- call write_pdb(1,'perturb structure',etot0)
-
- do i=2,500,2
- jr=iran_num(j1,j2)
- d=ran_number(-da,da)
- phiold=phi(jr)
- phi(jr)=pinorm(phi(jr)+d)
- call chainbuild
- call etotal(energy(0))
- etot=energy(0)
-
- if (etot.lt.etot0) then
- accepted=.true.
- else
- accepted=.false.
- xxr=ran_number(0.0D0,1.0D0)
- xxh=betbol*(etot-etot0)
- if (xxh.lt.50.0D0) then
- xxh=dexp(-xxh)
- if (xxh.gt.xxr) accepted=.true.
- endif
- endif
- accepted=.true.
-c print *,etot0,etot,accepted
- if (accepted) then
- etot0=etot
- call rmsd(rms)
- write(iout,*) 'etot=',i,etot,rms
- call write_pdb(i,'MC structure',etot)
-c minimize
-c call geom_to_var(nvar,var1)
- call sc_move(2,nres-1,1,10d0,nft_sc,etot)
- call geom_to_var(nvar,var)
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun
- call var_to_geom(nvar,var)
- call chainbuild
- call rmsd(rms)
- write(iout,*) 'etot mcm=',i,etot,rms
- call write_pdb(i+1,'MCM structure',etot)
- call var_to_geom(nvar,var1)
-c --------
- else
- phi(jr)=phiold
- endif
- enddo
-
-c minimize
-c call sc_move(2,nres-1,1,10d0,nft_sc,etot)
-c call geom_to_var(nvar,var)
-c
-c call chainbuild
-c call write_pdb(998 ,'sc min',etot)
-c
-c call minimize(etot,var,iretcode,nfun)
-c write(iout,*)'------------------------------------------------'
-c write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun
-c
-c call var_to_geom(nvar,var)
-c call chainbuild
-c call write_pdb(999,'full min',etot)
-
-
- return
- end
-
-
-
-
- subroutine test_local
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision varia(maxvar)
-c
- call chainbuild
-c call geom_to_var(nvar,varia)
- call write_pdb(1,'first structure',0d0)
-
- call etotal(energy(0))
- etot=energy(0)
- write(iout,*) nnt,nct,etot
-
- write(iout,*) 'calling sc_move'
- call sc_move(nnt,nct,5,10d0,nft_sc,etot)
- write(iout,*) nft_sc,etot
- call write_pdb(2,'second structure',etot)
-
- write(iout,*) 'calling local_move'
- call local_move_init(.false.)
- call local_move(24,29,20d0,50d0)
- call chainbuild
- call write_pdb(3,'third structure',etot)
-
- write(iout,*) 'calling sc_move'
- call sc_move(24,29,5,10d0,nft_sc,etot)
- write(iout,*) nft_sc,etot
- call write_pdb(2,'last structure',etot)
-
-
- return
- end
-
- subroutine test_sc
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.INTERACT'
- include 'COMMON.IOUNITS'
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision varia(maxvar)
-c
- call chainbuild
-c call geom_to_var(nvar,varia)
- call write_pdb(1,'first structure',0d0)
-
- call etotal(energy(0))
- etot=energy(0)
- write(iout,*) nnt,nct,etot
-
- write(iout,*) 'calling sc_move'
-
- call sc_move(nnt,nct,5,10d0,nft_sc,etot)
- write(iout,*) nft_sc,etot
- call write_pdb(2,'second structure',etot)
-
- write(iout,*) 'calling sc_move 2nd time'
-
- call sc_move(nnt,nct,5,1d0,nft_sc,etot)
- write(iout,*) nft_sc,etot
- call write_pdb(3,'last structure',etot)
- return
- end
-c--------------------------------------------------------
- subroutine bgrow(bstrand,nbstrand,in,ind,new)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- integer bstrand(maxres/3,6)
-
- ishift=iabs(bstrand(in,ind+4)-new)
-
- print *,'bgrow',bstrand(in,ind+4),new,ishift
-
- bstrand(in,ind)=new
-
- if(ind.eq.1)then
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- do i=1,nbstrand-1
- IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN
- if (bstrand(i,5).lt.bstrand(i,6)) then
- bstrand(i,5)=bstrand(i,5)-ishift
- else
- bstrand(i,5)=bstrand(i,5)+ishift
- endif
- ENDIF
- enddo
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- do i=1,nbstrand-1
- IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN
- if (bstrand(i,6).lt.bstrand(i,5)) then
- bstrand(i,6)=bstrand(i,6)-ishift
- else
- bstrand(i,6)=bstrand(i,6)+ishift
- endif
- ENDIF
- enddo
- endif
-
-
- return
- end
-
-
-c-------------------------------------------------
-
- subroutine secondary(lprint)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.DISTFIT'
-
- integer ncont,icont(2,maxres*maxres/2),isec(maxres,3)
- logical lprint,not_done
- real dcont(maxres*maxres/2),d
- real rcomp /7.0/
- real rbeta /5.2/
- real ralfa /5.2/
- real r310 /6.6/
- double precision xpi(3),xpj(3)
-
-
-
- call chainbuild
-cd call write_pdb(99,'sec structure',0d0)
- ncont=0
- nbfrag=0
- nhfrag=0
- do i=1,nres
- isec(i,1)=0
- isec(i,2)=0
- isec(i,3)=0
- enddo
-
- do i=2,nres-3
- do k=1,3
- xpi(k)=0.5d0*(c(k,i-1)+c(k,i))
- enddo
- do j=i+2,nres
- do k=1,3
- xpj(k)=0.5d0*(c(k,j-1)+c(k,j))
- enddo
-cd d = (c(1,i)-c(1,j))*(c(1,i)-c(1,j)) +
-cd & (c(2,i)-c(2,j))*(c(2,i)-c(2,j)) +
-cd & (c(3,i)-c(3,j))*(c(3,i)-c(3,j))
-cd print *,'CA',i,j,d
- d = (xpi(1)-xpj(1))*(xpi(1)-xpj(1)) +
- & (xpi(2)-xpj(2))*(xpi(2)-xpj(2)) +
- & (xpi(3)-xpj(3))*(xpi(3)-xpj(3))
- if ( d.lt.rcomp*rcomp) then
- ncont=ncont+1
- icont(1,ncont)=i
- icont(2,ncont)=j
- dcont(ncont)=sqrt(d)
- endif
- enddo
- enddo
- if (lprint) then
- write (iout,*)
- write (iout,'(a)') '#PP contact map distances:'
- do i=1,ncont
- write (iout,'(3i4,f10.5)')
- & i,icont(1,i),icont(2,i),dcont(i)
- enddo
- endif
-
-c finding parallel beta
-cd write (iout,*) '------- looking for parallel beta -----------'
- nbeta=0
- nstrand=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if(dcont(i).le.rbeta .and. j1-i1.gt.4 .and.
- & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
- & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
- & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
- & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
- & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
- & ) then
- ii1=i1
- jj1=j1
-cd write (iout,*) i1,j1,dcont(i)
- not_done=.true.
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)
- & .and. dcont(j).le.rbeta .and.
- & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
- & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
- & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
- & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
- & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
- & ) goto 5
- enddo
- not_done=.false.
- 5 continue
-cd write (iout,*) i1,j1,dcont(j),not_done
- enddo
- j1=j1-1
- i1=i1-1
- if (i1-ii1.gt.1) then
- ii1=max0(ii1-1,1)
- jj1=max0(jj1-1,1)
- nbeta=nbeta+1
- if(lprint)write(iout,*)'parallel beta',nbeta,ii1,i1,jj1,j1
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=ii1
- bfrag(2,nbfrag)=i1
- bfrag(3,nbfrag)=jj1
- bfrag(4,nbfrag)=j1
-
- do ij=ii1,i1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
- do ij=jj1,j1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
-
- if(lprint) then
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-1,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-1,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",jj1-1,"..",j1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",jj1-1,"..",j1-1,"'"
- endif
- write(12,'(a8,4i4)')
- & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1
- endif
- endif
- endif
- enddo
-
-c finding antiparallel beta
-cd write (iout,*) '--------- looking for antiparallel beta ---------'
-
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (dcont(i).le.rbeta.and.
- & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
- & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
- & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
- & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
- & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
- & ) then
- ii1=i1
- jj1=j1
-cd write (iout,*) i1,j1,dcont(i)
-
- not_done=.true.
- do while (not_done)
- i1=i1+1
- j1=j1-1
- do j=1,ncont
- if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and.
- & isec(i1,1).le.1.and.isec(j1,1).le.1.and.
- & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and.
- & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and.
- & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and.
- & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0)
- & .and. dcont(j).le.rbeta ) goto 6
- enddo
- not_done=.false.
- 6 continue
-cd write (iout,*) i1,j1,dcont(j),not_done
- enddo
- i1=i1-1
- j1=j1+1
- if (i1-ii1.gt.1) then
- if(lprint)write (iout,*)'antiparallel beta',
- & nbeta,ii1-1,i1,jj1,j1-1
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=max0(ii1-1,1)
- bfrag(2,nbfrag)=i1
- bfrag(3,nbfrag)=jj1
- bfrag(4,nbfrag)=max0(j1-1,1)
-
- nbeta=nbeta+1
- iii1=max0(ii1-1,1)
- do ij=iii1,i1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
- jjj1=max0(j1-1,1)
- do ij=jjj1,jj1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
-
-
- if (lprint) then
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-2,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",ii1-2,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",j1-2,"..",jj1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'strand",nstrand,
- & "' 'num = ",j1-2,"..",jj1-1,"'"
- endif
- write(12,'(a8,4i4)')
- & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2
- endif
- endif
- endif
- enddo
-
- if (nstrand.gt.0.and.lprint) then
- write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1"
- do i=2,nstrand
- if (i.le.9) then
- write(12,'(a9,i1,$)') " | strand",i
- else
- write(12,'(a9,i2,$)') " | strand",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
-
-c finding alpha or 310 helix
-
- nhelix=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (j1.eq.i1+3.and.dcont(i).le.r310
- & .or.j1.eq.i1+4.and.dcont(i).le.ralfa ) then
-cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,dcont(i)
-cd if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,dcont(i)
- ii1=i1
- jj1=j1
- if (isec(ii1,1).eq.0) then
- not_done=.true.
- else
- not_done=.false.
- endif
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10
- enddo
- not_done=.false.
- 10 continue
-cd write (iout,*) i1,j1,not_done
- enddo
- j1=j1-1
- if (j1-ii1.gt.4) then
- nhelix=nhelix+1
-cd write (iout,*)'helix',nhelix,ii1,j1
-
- nhfrag=nhfrag+1
- hfrag(1,nhfrag)=ii1
- hfrag(2,nhfrag)=max0(j1-1,1)
-
- do ij=ii1,j1
- isec(ij,1)=-1
- enddo
- if (lprint) then
- write (iout,'(a6,i3,2i4)') "Helix",nhelix,ii1-1,j1-2
- if (nhelix.le.9) then
- write(12,'(a17,i1,a9,i3,a2,i3,a1)')
- & "DefPropRes 'helix",nhelix,
- & "' 'num = ",ii1-1,"..",j1-2,"'"
- else
- write(12,'(a17,i2,a9,i3,a2,i3,a1)')
- & "DefPropRes 'helix",nhelix,
- & "' 'num = ",ii1-1,"..",j1-2,"'"
- endif
- endif
- endif
- endif
- enddo
-
- if (nhelix.gt.0.and.lprint) then
- write(12,'(a26,$)') "DefPropRes 'helix' 'helix1"
- do i=2,nhelix
- if (nhelix.le.9) then
- write(12,'(a8,i1,$)') " | helix",i
- else
- write(12,'(a8,i2,$)') " | helix",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
- if (lprint) then
- write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'"
- write(12,'(a20)') "XMacStand ribbon.mac"
- endif
-
-
- return
- end
-c----------------------------------------------------------------------------
-
- subroutine write_pdb(npdb,titelloc,ee)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- character*50 titelloc1
- character*(*) titelloc
- character*3 zahl
- character*5 liczba5
- double precision ee
- integer npdb,ilen
- external ilen
-
- titelloc1=titelloc
- lenpre=ilen(prefix)
- if (npdb.lt.1000) then
- call numstr(npdb,zahl)
- open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb')
- else
- if (npdb.lt.10000) then
- write(liczba5,'(i1,i4)') 0,npdb
- else
- write(liczba5,'(i5)') npdb
- endif
- open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb')
- endif
- call pdbout(ee,titelloc1,ipdb)
- close(ipdb)
- return
- end
-
-c--------------------------------------------------------
- subroutine softreg
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.GEO'
- include 'COMMON.CHAIN'
- include 'COMMON.IOUNITS'
- include 'COMMON.VAR'
- include 'COMMON.CONTROL'
- include 'COMMON.SBRIDGE'
- include 'COMMON.FFIELD'
- include 'COMMON.MINIM'
- include 'COMMON.INTERACT'
-c
- include 'COMMON.DISTFIT'
- integer iff(maxres)
- double precision time0,time1
- double precision energy(0:n_ene),ee
- double precision var(maxvar)
- integer ieval
-c
- logical debug,ltest,fail
- character*50 linia
-c
- linia='test'
- debug=.true.
- in_pdb=0
-
-
-
-c------------------------
-c
-c freeze sec.elements
-c
- do i=1,nres
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- iff(i)=0
- enddo
-
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- enddo
- mask_r=.true.
-
-
-
- nhpb0=nhpb
-c
-c store dist. constrains
-c
- do i=1,nres-3
- do j=i+3,nres
- if ( iff(i).eq.1.and.iff(j).eq.1 ) then
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=0.1
- dhpb(nhpb)=DIST(i,j)
- endif
- enddo
- enddo
- call hpb_partition
-
- if (debug) then
- call chainbuild
- call write_pdb(100+in_pdb,'input reg. structure',0d0)
- endif
-
-
- ipot0=ipot
- maxmin0=maxmin
- maxfun0=maxfun
- wstrain0=wstrain
- wang0=wang
-c
-c run soft pot. optimization
-c
- ipot=6
- wang=3.0
- maxmin=2000
- maxfun=4000
- call geom_to_var(nvar,var)
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
-
- write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
- & nfun/(time1-time0),' SOFT eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(300+in_pdb,'soft structure',etot)
- endif
-c
-c run full UNRES optimization with constrains and frozen 2D
-c the same variables as soft pot. optimizatio
-c
- ipot=ipot0
- wang=wang0
- maxmin=maxmin0
- maxfun=maxfun0
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL MASK DIST return code is',iretcode,
- & ' eval ',nfun
- ieval=nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')
- & ' Time for mask dist min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(400+in_pdb,'mask & dist',etot)
- endif
-c
-c switch off constrains and
-c run full UNRES optimization with frozen 2D
-c
-
-c
-c reset constrains
-c
- nhpb_c=nhpb
- nhpb=nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
-
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL MASK return code is',iretcode,' eval ',nfun
- ieval=ieval+nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for mask min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-
-
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(500+in_pdb,'mask 2d frozen',etot)
- endif
-
- mask_r=.false.
-
-
-c
-c run full UNRES optimization with constrains and NO frozen 2D
-c
-
- nhpb=nhpb_c
- link_start=1
- link_end=nhpb
- maxfun=maxfun0/5
-
- do ico=1,5
-
- wstrain=wstrain0/ico
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,'(a10,f6.3,a14,i3,a6,i5)')
- & ' SUMSL DIST',wstrain,' return code is',iretcode,
- & ' eval ',nfun
- ieval=nfun
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')
- & ' Time for dist min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(600+in_pdb+ico,'dist cons',etot)
- endif
-
- enddo
-c
- nhpb=nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
- maxfun=maxfun0
-
-
-c
- if (minim) then
-#ifdef MPI
- time0=MPI_WTIME()
-#else
- time0=tcpu()
-#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
- & '+ DIST eval',ieval
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,
- & nfun/(time1-time0),' eval/s'
-
-
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(999,'full min',etot)
- endif
-
- return
- end
-
-
+++ /dev/null
- subroutine thread_seq
-C Thread the sequence through a database of known structures
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.CHAIN'
- include 'COMMON.DBASE'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.THREAD'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.CONTACTS'
- include 'COMMON.MCM'
- include 'COMMON.NAMES'
-#ifdef MPI
- include 'COMMON.INFO'
- integer ThreadId,ThreadType,Kwita
-#endif
- double precision varia(maxvar)
- double precision przes(3),obr(3,3)
- double precision time_for_thread
- logical found_pattern,non_conv
- character*32 head_pdb
- double precision energia(0:n_ene)
- n_ene_comp=nprint_ene
-C
-C Body
-C
-#ifdef MPI
- if (me.eq.king) then
- do i=1,nctasks
- nsave_part(i)=0
- enddo
- endif
- nacc_tot=0
-#endif
- Kwita=0
- close(igeom)
- close(ipdb)
- close(istat)
- do i=1,maxthread
- do j=1,14
- ener0(j,i)=0.0D0
- ener(j,i)=0.0D0
- enddo
- enddo
- nres0=nct-nnt+1
- ave_time_for_thread=0.0D0
- max_time_for_thread=0.0D0
-cd print *,'nthread=',nthread,' nseq=',nseq,' nres0=',nres0
- nthread=nexcl+nthread
- do ithread=1,nthread
- found_pattern=.false.
- itrial=0
- do while (.not.found_pattern)
- itrial=itrial+1
- if (itrial.gt.1000) then
- write (iout,'(/a/)') 'Too many attempts to find pattern.'
- nthread=ithread-1
-#ifdef MPI
- call recv_stop_sig(Kwita)
- call send_stop_sig(-3)
-#endif
- goto 777
- endif
-C Find long enough chain in the database
- ii=iran_num(1,nseq)
- nres_t=nres_base(1,ii)
-C Select the starting position to thread.
- print *,'nseq',nseq,' ii=',ii,' nres_t=',
- & nres_t,' nres0=',nres0
- if (nres_t.ge.nres0) then
- ist=iran_num(0,nres_t-nres0)
-#ifdef MPI
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
- if (Kwita.lt.0) then
- write (iout,*) 'Stop signal received. Terminating.'
- write (*,*) 'Stop signal received. Terminating.'
- nthread=ithread-1
- write (*,*) 'ithread=',ithread,' nthread=',nthread
- goto 777
- endif
- call pattern_receive
-#endif
- do i=1,nexcl
- if (iexam(1,i).eq.ii .and. iexam(2,i).eq.ist) goto 10
- enddo
- found_pattern=.true.
- endif
-C If this point is reached, the pattern has not yet been examined.
- 10 continue
-c print *,'found_pattern:',found_pattern
- enddo
- nexcl=nexcl+1
- iexam(1,nexcl)=ii
- iexam(2,nexcl)=ist
-#ifdef MPI
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
- if (Kwita.lt.0) then
- write (iout,*) 'Stop signal received. Terminating.'
- nthread=ithread-1
- write (*,*) 'ithread=',ithread,' nthread=',nthread
- goto 777
- endif
- call pattern_send
-#endif
- ipatt(1,ithread)=ii
- ipatt(2,ithread)=ist
-#ifdef MPI
- write (iout,'(/80(1h*)/a,i4,a,i5,2a,i3,a,i3,a,i3/)')
- & 'Processor:',me,' Attempt:',ithread,
- & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii),
- & ' start at res.',ist+1
- write (*,'(a,i4,a,i5,2a,i3,a,i3,a,i3)') 'Processor:',me,
- & ' Attempt:',ithread,
- & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii),
- & ' start at res.',ist+1
-#else
- write (iout,'(/80(1h*)/a,i5,2a,i3,a,i3,a,i3/)')
- & 'Attempt:',ithread,
- & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii),
- & ' start at res.',ist+1
- write (*,'(a,i5,2a,i3,a,i3,a,i3)')
- & 'Attempt:',ithread,
- & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii),
- & ' start at res.',ist+1
-#endif
- ipattern=ii
-C Copy coordinates from the database.
- ist=ist-(nnt-1)
- do i=nnt,nct
- do j=1,3
- c(j,i)=cart_base(j,i+ist,ii)
-c cref(j,i)=c(j,i)
- enddo
-cd write (iout,'(a,i4,3f10.5)') restyp(itype(i)),i,(c(j,i),j=1,3)
- enddo
-cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr,
-cd non_conv)
-cd write (iout,'(a,f10.5)')
-cd & 'Initial RMS deviation from reference structure:',rms
- if (itype(nres).eq.21) then
- do j=1,3
- dcj=c(j,nres-2)-c(j,nres-3)
- c(j,nres)=c(j,nres-1)+dcj
- c(j,2*nres)=c(j,nres)
- enddo
- endif
- if (itype(1).eq.21) then
- do j=1,3
- dcj=c(j,4)-c(j,3)
- c(j,1)=c(j,2)-dcj
- c(j,nres+1)=c(j,1)
- enddo
- endif
- call int_from_cart(.false.,.false.)
-cd print *,'Exit INT_FROM_CART.'
-cd print *,'nhpb=',nhpb
- do i=nss+1,nhpb
- ii=ihpb(i)
- jj=jhpb(i)
- dhpb(i)=dist(ii,jj)
-c write (iout,'(2i5,2f10.5)') ihpb(i),jhpb(i),dhpb(i),forcon(i)
- enddo
-c stop 'End generate'
-C Generate SC conformations.
- call sc_conf
-c call intout
-#ifdef MPI
-cd print *,'Processor:',me,': exit GEN_SIDE.'
-#else
-cd print *,'Exit GEN_SIDE.'
-#endif
-C Calculate initial energy.
- call chainbuild
- call etotal(energia(0))
- etot=energia(0)
- do i=1,n_ene_comp
- ener0(i,ithread)=energia(i)
- enddo
- ener0(n_ene_comp+1,ithread)=energia(0)
- if (refstr) then
- call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- ener0(n_ene_comp+3,ithread)=contact_fract(ncont,ncont_ref,
- & icont,icont_ref)
- ener0(n_ene_comp+2,ithread)=rms
- ener0(n_ene_comp+4,ithread)=frac
- ener0(n_ene_comp+5,ithread)=frac_nn
- endif
- ener0(n_ene_comp+3,ithread)=0.0d0
-C Minimize energy.
-#ifdef MPI
- print*,'Processor:',me,' ithread=',ithread,' Start REGULARIZE.'
-#else
- print*,'ithread=',ithread,' Start REGULARIZE.'
-#endif
- curr_tim=tcpu()
- call regularize(nct-nnt+1,etot,rms,
- & cart_base(1,ist+nnt,ipattern),iretcode)
- curr_tim1=tcpu()
- time_for_thread=curr_tim1-curr_tim
- ave_time_for_thread=
- & ((ithread-1)*ave_time_for_thread+time_for_thread)/ithread
- if (time_for_thread.gt.max_time_for_thread)
- & max_time_for_thread=time_for_thread
-#ifdef MPI
- print *,'Processor',me,': Exit REGULARIZE.'
- if (WhatsUp.eq.2) then
- write (iout,*)
- & 'Sufficient number of confs. collected. Terminating.'
- nthread=ithread-1
- goto 777
- else if (WhatsUp.eq.-1) then
- nthread=ithread-1
- write (iout,*) 'Time up in REGULARIZE. Call SEND_STOP_SIG.'
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
- call send_stop_sig(-2)
- goto 777
- else if (WhatsUp.eq.-2) then
- nthread=ithread-1
- write (iout,*) 'Timeup signal received. Terminating.'
- goto 777
- else if (WhatsUp.eq.-3) then
- nthread=ithread-1
- write (iout,*) 'Error stop signal received. Terminating.'
- goto 777
- endif
-#else
- print *,'Exit REGULARIZE.'
- if (iretcode.eq.11) then
- write (iout,'(/a/)')
- &'******* Allocated time exceeded in SUMSL. The program will stop.'
- nthread=ithread-1
- goto 777
- endif
-#endif
- head_pdb=titel(:24)//':'//str_nam(ipattern)
- if (outpdb) call pdbout(etot,head_pdb,ipdb)
- if (outmol2) call mol2out(etot,head_pdb)
-c call intout
- call briefout(ithread,etot)
- link_end0=link_end
- link_end=min0(link_end,nss)
- write (iout,*) 'link_end=',link_end,' link_end0=',link_end0,
- & ' nss=',nss
- call etotal(energia(0))
-c call enerprint(energia(0))
- link_end=link_end0
-cd call chainbuild
-cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr,non_conv)
-cd write (iout,'(a,f10.5)')
-cd & 'RMS deviation from reference structure:',dsqrt(rms)
- do i=1,n_ene_comp
- ener(i,ithread)=energia(i)
- enddo
- ener(n_ene_comp+1,ithread)=energia(0)
- ener(n_ene_comp+3,ithread)=rms
- if (refstr) then
- call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- ener(n_ene_comp+2,ithread)=rms
- ener(n_ene_comp+4,ithread)=frac
- ener(n_ene_comp+5,ithread)=frac_nn
- endif
- call write_stat_thread(ithread,ipattern,ist)
-c write (istat,'(i4,2x,a8,i4,11(1pe14.5),2(0pf8.3),f8.5)')
-c & ithread,str_nam(ipattern),ist+1,(ener(k,ithread),k=1,11),
-c & (ener(k,ithread),k=12,14)
-#ifdef MPI
- if (me.eq.king) then
- nacc_tot=nacc_tot+1
- call pattern_receive
- call receive_MCM_info
- if (nacc_tot.ge.nthread) then
- write (iout,*)
- & 'Sufficient number of conformations collected nacc_tot=',
- & nacc_tot,'. Stopping other processors and terminating.'
- write (*,*)
- & 'Sufficient number of conformations collected nacc_tot=',
- & nacc_tot,'. Stopping other processors and terminating.'
- call recv_stop_sig(Kwita)
- if (Kwita.eq.0) call send_stop_sig(-1)
- nthread=ithread
- goto 777
- endif
- else
- call send_MCM_info(2)
- endif
-#endif
- if (timlim-curr_tim1-safety .lt. max_time_for_thread) then
- write (iout,'(/2a)')
- & '********** There would be not enough time for another thread. ',
- & 'The program will stop.'
- write (*,'(/2a)')
- & '********** There would be not enough time for another thread. ',
- & 'The program will stop.'
- write (iout,'(a,1pe14.4/)')
- & 'Elapsed time for last threading step: ',time_for_thread
- nthread=ithread
-#ifdef MPI
- call recv_stop_sig(Kwita)
- call send_stop_sig(-2)
-#endif
- goto 777
- else
- curr_tim=curr_tim1
- write (iout,'(a,1pe14.4)')
- & 'Elapsed time for this threading step: ',time_for_thread
- endif
-#ifdef MPI
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
- if (Kwita.lt.0) then
- write (iout,*) 'Stop signal received. Terminating.'
- write (*,*) 'Stop signal received. Terminating.'
- nthread=ithread
- write (*,*) 'nthread=',nthread,' ithread=',ithread
- goto 777
- endif
-#endif
- enddo
-#ifdef MPI
- call send_stop_sig(-1)
-#endif
- 777 continue
-#ifdef MPI
-C Any messages left for me?
- call pattern_receive
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
-#endif
- call write_thread_summary
-#ifdef MPI
- if (king.eq.king) then
- Kwita=1
- do while (Kwita.ne.0 .or. nacc_tot.ne.0)
- Kwita=0
- nacc_tot=0
- call recv_stop_sig(Kwita)
- call receive_MCM_info
- enddo
- do iproc=1,nprocs-1
- call receive_thread_results(iproc)
- enddo
- call write_thread_summary
- else
- call send_thread_results
- endif
-#endif
- return
- end
-c--------------------------------------------------------------------------
- subroutine write_thread_summary
-C Thread the sequence through a database of known structures
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.CONTROL'
- include 'COMMON.CHAIN'
- include 'COMMON.DBASE'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.THREAD'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.NAMES'
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
-#ifdef MPI
- include 'COMMON.INFO'
-#endif
- dimension ip(maxthread)
- double precision energia(0:n_ene)
- write (iout,'(30x,a/)')
- & ' *********** Summary threading statistics ************'
- write (iout,'(a)') 'Initial energies:'
- write (iout,'(a4,2x,a12,14a14,3a8)')
- & 'No','seq',(ename(print_order(i)),i=1,nprint_ene),'ETOT',
- & 'RMSnat','NatCONT','NNCONT','RMS'
-C Energy sort patterns
- do i=1,nthread
- ip(i)=i
- enddo
- do i=1,nthread-1
- enet=ener(n_ene-1,ip(i))
- jj=i
- do j=i+1,nthread
- if (ener(n_ene-1,ip(j)).lt.enet) then
- jj=j
- enet=ener(n_ene-1,ip(j))
- endif
- enddo
- if (jj.ne.i) then
- ipj=ip(jj)
- ip(jj)=ip(i)
- ip(i)=ipj
- endif
- enddo
- do ik=1,nthread
- i=ip(ik)
- ii=ipatt(1,i)
- ist=nres_base(2,ii)+ipatt(2,i)
- do kk=1,n_ene_comp
- energia(i)=ener0(kk,i)
- enddo
- etot=ener0(n_ene_comp+1,i)
- rmsnat=ener0(n_ene_comp+2,i)
- rms=ener0(n_ene_comp+3,i)
- frac=ener0(n_ene_comp+4,i)
- frac_nn=ener0(n_ene_comp+5,i)
-
- if (refstr) then
- write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)')
- & i,str_nam(ii),ist+1,
- & (energia(print_order(kk)),kk=1,nprint_ene),
- & etot,rmsnat,frac,frac_nn,rms
- else
- write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3)')
- & i,str_nam(ii),ist+1,
- & (energia(print_order(kk)),kk=1,nprint_ene),etot
- endif
- enddo
- write (iout,'(//a)') 'Final energies:'
- write (iout,'(a4,2x,a12,17a14,3a8)')
- & 'No','seq',(ename(print_order(kk)),kk=1,nprint_ene),'ETOT',
- & 'RMSnat','NatCONT','NNCONT','RMS'
- do ik=1,nthread
- i=ip(ik)
- ii=ipatt(1,i)
- ist=nres_base(2,ii)+ipatt(2,i)
- do kk=1,n_ene_comp
- energia(kk)=ener(kk,ik)
- enddo
- etot=ener(n_ene_comp+1,i)
- rmsnat=ener(n_ene_comp+2,i)
- rms=ener(n_ene_comp+3,i)
- frac=ener(n_ene_comp+4,i)
- frac_nn=ener(n_ene_comp+5,i)
- write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)')
- & i,str_nam(ii),ist+1,
- & (energia(print_order(kk)),kk=1,nprint_ene),
- & etot,rmsnat,frac,frac_nn,rms
- enddo
- write (iout,'(/a/)') 'IEXAM array:'
- write (iout,'(i5)') nexcl
- do i=1,nexcl
- write (iout,'(2i5)') iexam(1,i),iexam(2,i)
- enddo
- write (iout,'(/a,1pe14.4/a,1pe14.4/)')
- & 'Max. time for threading step ',max_time_for_thread,
- & 'Average time for threading step: ',ave_time_for_thread
- return
- end
-c----------------------------------------------------------------------------
- subroutine sc_conf
-C Sample (hopefully) optimal SC orientations given backcone conformation.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CHAIN'
- include 'COMMON.DBASE'
- include 'COMMON.INTERACT'
- include 'COMMON.VAR'
- include 'COMMON.THREAD'
- include 'COMMON.FFIELD'
- include 'COMMON.SBRIDGE'
- include 'COMMON.HEADER'
- include 'COMMON.GEO'
- include 'COMMON.IOUNITS'
- double precision varia(maxvar)
- common /srutu/ icall
- double precision energia(0:n_ene)
- logical glycine,fail
- maxsample=10
- link_end0=link_end
- link_end=min0(link_end,nss)
- do i=nnt,nct
- if (itype(i).ne.10) then
-cd print *,'i=',i,' itype=',itype(i),' theta=',theta(i+1)
- call gen_side(itype(i),theta(i+1),alph(i),omeg(i),fail)
- endif
- enddo
- call chainbuild
- call etotal(energia(0))
- do isample=1,maxsample
-C Choose a non-glycine side chain.
- glycine=.true.
- do while(glycine)
- ind_sc=iran_num(nnt,nct)
- glycine=(itype(ind_sc).eq.10)
- enddo
- alph0=alph(ind_sc)
- omeg0=omeg(ind_sc)
- call gen_side(itype(ind_sc),theta(ind_sc+1),alph(ind_sc),
- & omeg(ind_sc),fail)
- call chainbuild
- call etotal(energia(0))
-cd write (iout,'(a,i5,a,i4,2(a,f8.3),2(a,1pe14.5))')
-cd & 'Step:',isample,' SC',ind_sc,' alpha',alph(ind_sc)*rad2deg,
-cd & ' omega',omeg(ind_sc)*rad2deg,' old energy',e0,' new energy',e1
- e1=0.0d0
- if (e0.le.e1) then
- alph(ind_sc)=alph0
- omeg(ind_sc)=omeg0
- else
- e0=e1
- endif
- enddo
- link_end=link_end0
- return
- end
-c---------------------------------------------------------------------------
- subroutine write_stat_thread(ithread,ipattern,ist)
- implicit real*8 (a-h,o-z)
- include "DIMENSIONS"
- include "COMMON.CONTROL"
- include "COMMON.IOUNITS"
- include "COMMON.THREAD"
- include "COMMON.FFIELD"
- include "COMMON.DBASE"
- include "COMMON.NAMES"
- double precision energia(0:n_ene)
-
-#if defined(AIX) || defined(PGI)
- open(istat,file=statname,position='append')
-#else
- open(istat,file=statname,access='append')
-#endif
- do i=1,n_ene_comp
- energia(i)=ener(i,ithread)
- enddo
- etot=ener(n_ene_comp+1,ithread)
- rmsnat=ener(n_ene_comp+2,ithread)
- rms=ener(n_ene_comp+3,ithread)
- frac=ener(n_ene_comp+4,ithread)
- frac_nn=ener(n_ene_comp+5,ithread)
- write (istat,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)')
- & ithread,str_nam(ipattern),ist+1,
- & (energia(print_order(i)),i=1,nprint_ene),
- & etot,rmsnat,frac,frac_nn,rms
- close (istat)
- return
- end
+++ /dev/null
-C $Date: 1994/10/05 16:41:52 $
-C $Revision: 2.2 $
-C
-C
-C
- subroutine set_timers
-c
- implicit none
- double precision tcpu
- include 'COMMON.TIME1'
-#ifdef MP
- include 'mpif.h'
-#endif
-C Diminish the assigned time limit a little so that there is some time to
-C end a batch job
-c timlim=batime-150.0
-C Calculate the initial time, if it is not zero (e.g. for the SUN).
- stime=tcpu()
-#ifdef MPI
- walltime=MPI_WTIME()
- time_reduce=0.0d0
- time_allreduce=0.0d0
- time_bcast=0.0d0
- time_gather=0.0d0
- time_sendrecv=0.0d0
- time_scatter=0.0d0
- time_scatter_fmat=0.0d0
- time_scatter_ginv=0.0d0
- time_scatter_fmatmult=0.0d0
- time_scatter_ginvmult=0.0d0
- time_barrier_e=0.0d0
- time_barrier_g=0.0d0
- time_enecalc=0.0d0
- time_sumene=0.0d0
- time_lagrangian=0.0d0
- time_sumgradient=0.0d0
- time_intcartderiv=0.0d0
- time_inttocart=0.0d0
- time_ginvmult=0.0d0
- time_fricmatmult=0.0d0
- time_cartgrad=0.0d0
- time_bcastc=0.0d0
- time_bcast7=0.0d0
- time_bcastw=0.0d0
- time_intfcart=0.0d0
- time_vec=0.0d0
- time_mat=0.0d0
- time_fric=0.0d0
- time_stoch=0.0d0
- time_fricmatmult=0.0d0
- time_fsample=0.0d0
-#endif
-cd print *,' in SET_TIMERS stime=',stime
- return
- end
-C------------------------------------------------------------------------------
- logical function stopx(nf)
-C This function returns .true. if one of the following reasons to exit SUMSL
-C occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block:
-C
-C... WHATSUP = 0 - go on, no reason to stop. Stopx will return .false.
-C... 1 - Time up in current node;
-C... 2 - STOP signal was received from another node because the
-C... node's task was accomplished (parallel only);
-C... -1 - STOP signal was received from another node because of error;
-C... -2 - STOP signal was received from another node, because
-C... the node's time was up.
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- integer nf
- logical ovrtim
-#ifdef MP
- include 'mpif.h'
- include 'COMMON.INFO'
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- integer Kwita
-
-cd print *,'Processor',MyID,' NF=',nf
-#ifndef MPI
- if (ovrtim()) then
-C Finish if time is up.
- stopx = .true.
- WhatsUp=1
-#ifdef MPL
- else if (mod(nf,100).eq.0) then
-C Other processors might have finished. Check this every 100th function
-C evaluation.
-C Master checks if any other processor has sent accepted conformation(s) to it.
- if (MyID.ne.MasterID) call receive_mcm_info
- if (MyID.eq.MasterID) call receive_conf
-cd print *,'Processor ',MyID,' is checking STOP: nf=',nf
- call recv_stop_sig(Kwita)
- if (Kwita.eq.-1) then
- write (iout,'(a,i4,a,i5)') 'Processor',
- & MyID,' has received STOP signal in STOPX; NF=',nf
- write (*,'(a,i4,a,i5)') 'Processor',
- & MyID,' has received STOP signal in STOPX; NF=',nf
- stopx=.true.
- WhatsUp=2
- elseif (Kwita.eq.-2) then
- write (iout,*)
- & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.'
- write (*,*)
- & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.'
- WhatsUp=-2
- stopx=.true.
- else if (Kwita.eq.-3) then
- write (iout,*)
- & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.'
- write (*,*)
- & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.'
- WhatsUp=-1
- stopx=.true.
- else
- stopx=.false.
- WhatsUp=0
- endif
-#endif
- else
- stopx = .false.
- WhatsUp=0
- endif
-#else
- stopx=.false.
-#endif
-
-#ifdef OSF
-c Check for FOUND_NAN flag
- if (FOUND_NAN) then
- write(iout,*)" *** stopx : Found a NaN"
- stopx=.true.
- endif
-#endif
-
- return
- end
-C--------------------------------------------------------------------------
- logical function ovrtim()
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- real*8 tcpu
-#ifdef MPI
- include "mpif.h"
- curtim = MPI_Wtime()-walltime
-#else
- curtim= tcpu()
-#endif
-C curtim is the current time in seconds.
-c write (iout,*) "curtim",curtim," timlim",timlim," safety",safety
- if (curtim .ge. timlim - safety) then
- if (me.eq.king .or. .not. out1file)
- & write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)')
- & "***************** Elapsed time (",curtim,
- & " s) is within the safety limit (",safety,
- & " s) of the allocated time (",timlim," s). Terminating."
- ovrtim=.true.
- else
- ovrtim=.false.
- endif
- return
- end
-**************************************************************************
- double precision function tcpu()
- include 'COMMON.TIME1'
-#ifdef ES9000
-****************************
-C Next definition for EAGLE (ibm-es9000)
- real*8 micseconds
- integer rcode
- tcpu=cputime(micseconds,rcode)
- tcpu=(micseconds/1.0E6) - stime
-****************************
-#endif
-#ifdef SUN
-****************************
-C Next definitions for sun
- REAL*8 ECPU,ETIME,ETCPU
- dimension tarray(2)
- tcpu=etime(tarray)
- tcpu=tarray(1)
-****************************
-#endif
-#ifdef KSR
-****************************
-C Next definitions for ksr
-C this function uses the ksr timer ALL_SECONDS from the PMON library to
-C return the elapsed time in seconds
- tcpu= all_seconds() - stime
-****************************
-#endif
-#ifdef SGI
-****************************
-C Next definitions for sgi
- real timar(2), etime
- seconds = etime(timar)
-Cd print *,'seconds=',seconds,' stime=',stime
-C usrsec = timar(1)
-C syssec = timar(2)
- tcpu=seconds - stime
-****************************
-#endif
-
-#ifdef LINUX
-****************************
-C Next definitions for sgi
- real timar(2), etime
- seconds = etime(timar)
-Cd print *,'seconds=',seconds,' stime=',stime
-C usrsec = timar(1)
-C syssec = timar(2)
- tcpu=seconds - stime
-****************************
-#endif
-
-
-#ifdef CRAY
-****************************
-C Next definitions for Cray
-C call date(curdat)
-C curdat=curdat(1:9)
-C call clock(curtim)
-C curtim=curtim(1:8)
- cpusec = second()
- tcpu=cpusec - stime
-****************************
-#endif
-#ifdef AIX
-****************************
-C Next definitions for RS6000
- integer*4 i1,mclock
- i1 = mclock()
- tcpu = (i1+0.0D0)/100.0D0
-#endif
-#ifdef WINPGI
-****************************
-c next definitions for windows NT Digital fortran
- real time_real
- call cpu_time(time_real)
- tcpu = time_real
-#endif
-#ifdef WINIFL
-****************************
-c next definitions for windows NT Digital fortran
- real time_real
- call cpu_time(time_real)
- tcpu = time_real
-#endif
-
- return
- end
-C---------------------------------------------------------------------------
- subroutine dajczas(rntime,hrtime,mintime,sectime)
- include 'COMMON.IOUNITS'
- real*8 rntime,hrtime,mintime,sectime
- hrtime=rntime/3600.0D0
- hrtime=aint(hrtime)
- mintime=aint((rntime-3600.0D0*hrtime)/60.0D0)
- sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0)
- if (sectime.eq.60.0D0) then
- sectime=0.0D0
- mintime=mintime+1.0D0
- endif
- ihr=hrtime
- imn=mintime
- isc=sectime
- write (iout,328) ihr,imn,isc
- 328 FORMAT(//'***** Computation time: ',I4 ,' hours ',I2 ,
- 1 ' minutes ', I2 ,' seconds *****')
- return
- end
-C---------------------------------------------------------------------------
- subroutine print_detailed_timing
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.IOUNITS'
- include 'COMMON.TIME1'
- include 'COMMON.SETUP'
-#ifdef MPI
- time1=MPI_WTIME()
- write (iout,'(80(1h=)/a/(80(1h=)))')
- & "Details of FG communication time"
- write (*,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))')
- & "BROADCAST:",time_bcast,"REDUCE:",time_reduce,
- & "GATHER:",time_gather,
- & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv,
- & "BARRIER ene",time_barrier_e,
- & "BARRIER grad",time_barrier_g,
- & "TOTAL:",
- & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv
- write (*,*) fg_rank,myrank,
- & ': Total wall clock time',time1-walltime,' sec'
- write (*,*) "Processor",fg_rank,myrank,
- & ": BROADCAST time",time_bcast," REDUCE time",
- & time_reduce," GATHER time",time_gather," SCATTER time",
- & time_scatter,
- & " SCATTER fmatmult",time_scatter_fmatmult,
- & " SCATTER ginvmult",time_scatter_ginvmult,
- & " SCATTER fmat",time_scatter_fmat,
- & " SCATTER ginv",time_scatter_ginv,
- & " SENDRECV",time_sendrecv,
- & " BARRIER ene",time_barrier_e,
- & " BARRIER GRAD",time_barrier_g,
- & " BCAST7",time_bcast7," BCASTC",time_bcastc,
- & " BCASTW",time_bcastw," ALLREDUCE",time_allreduce,
- & " TOTAL",
- & time_bcast+time_reduce+time_gather+time_scatter+
- & time_sendrecv+time_barrier+time_bcastc
-#else
- time1=tcpu()
-#endif
- write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc
- write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene
- write (*,*) "Processor",fg_rank,myrank," intfromcart",
- & time_intfcart
- write (*,*) "Processor",fg_rank,myrank," vecandderiv",
- & time_vec
- write (*,*) "Processor",fg_rank,myrank," setmatrices",
- & time_mat
- write (*,*) "Processor",fg_rank,myrank," ginvmult",
- & time_ginvmult
- write (*,*) "Processor",fg_rank,myrank," fricmatmult",
- & time_fricmatmult
- write (*,*) "Processor",fg_rank,myrank," inttocart",
- & time_inttocart
- write (*,*) "Processor",fg_rank,myrank," sumgradient",
- & time_sumgradient
- write (*,*) "Processor",fg_rank,myrank," intcartderiv",
- & time_intcartderiv
- if (fg_rank.eq.0) then
- write (*,*) "Processor",fg_rank,myrank," lagrangian",
- & time_lagrangian
- write (*,*) "Processor",fg_rank,myrank," cartgrad",
- & time_cartgrad
- endif
- return
- end
+++ /dev/null
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
-C U N R E S C
-C C
-C Program to carry out conformational search of proteins in an united-residue C
-C approximation. C
-C C
-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-
-
-#ifdef MPI
- include 'mpif.h'
- include 'COMMON.SETUP'
-#endif
- include 'COMMON.TIME1'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.REMD'
- include 'COMMON.MD'
- include 'COMMON.SBRIDGE'
- double precision hrtime,mintime,sectime
- character*64 text_mode_calc(-2:14) /'test',
- & 'SC rotamer distribution',
- & 'Energy evaluation or minimization',
- & 'Regularization of PDB structure',
- & 'Threading of a sequence on PDB structures',
- & 'Monte Carlo (with minimization) ',
- & 'Energy minimization of multiple conformations',
- & 'Checking energy gradient',
- & 'Entropic sampling Monte Carlo (with minimization)',
- & 'Energy map',
- & 'CSA calculations',
- & 'Not used 9',
- & 'Not used 10',
- & 'Soft regularization of PDB structure',
- & 'Mesoscopic molecular dynamics (MD) ',
- & 'Not used 13',
- & 'Replica exchange molecular dynamics (REMD)'/
- external ilen
-
-c call memmon_print_usage()
-
- call init_task
- if (me.eq.king)
- & write(iout,*)'### LAST MODIFIED 03/28/12 23:29 by czarek'
- if (me.eq.king) call cinfo
-C Read force field parameters and job setup data
- call readrtns
- call flush(iout)
-C
- if (me.eq.king .or. .not. out1file) then
- write (iout,'(2a/)')
- & text_mode_calc(modecalc)(:ilen(text_mode_calc(modecalc))),
- & ' calculation.'
- if (minim) write (iout,'(a)')
- & 'Conformations will be energy-minimized.'
- write (iout,'(80(1h*)/)')
- endif
- call flush(iout)
-C
- if (modecalc.eq.-2) then
- call test
- stop
- else if (modecalc.eq.-1) then
- write(iout,*) "call check_sc_map next"
- call check_bond
- stop
- endif
-#ifdef MPI
- if (fg_rank.gt.0) then
-C Fine-grain slaves just do energy and gradient components.
- call ergastulum ! slave workhouse in Latin
- else
-#endif
- if (modecalc.eq.0) then
- call exec_eeval_or_minim
- else if (modecalc.eq.1) then
- call exec_regularize
- else if (modecalc.eq.2) then
- call exec_thread
- else if (modecalc.eq.3 .or. modecalc .eq.6) then
- call exec_MC
- else if (modecalc.eq.4) then
- call exec_mult_eeval_or_minim
- else if (modecalc.eq.5) then
- call exec_checkgrad
- else if (ModeCalc.eq.7) then
- call exec_map
- else if (ModeCalc.eq.8) then
- call exec_CSA
- else if (modecalc.eq.11) then
- call exec_softreg
- else if (modecalc.eq.12) then
- call exec_MD
- else if (modecalc.eq.14) then
- call exec_MREMD
- else
- write (iout,'(a)') 'This calculation type is not supported',
- & ModeCalc
- endif
-#ifdef MPI
- endif
-C Finish task.
- if (fg_rank.eq.0) call finish_task
-c call memmon_print_usage()
-#ifdef TIMING
- call print_detailed_timing
-#endif
- call MPI_Finalize(ierr)
- stop 'Bye Bye...'
-#else
- call dajczas(tcpu(),hrtime,mintime,sectime)
- stop '********** Program terminated normally.'
-#endif
- end
-c--------------------------------------------------------------------------
- subroutine exec_MD
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- if (me.eq.king .or. .not. out1file)
- & write (iout,*) "Calling chainbuild"
- call chainbuild
- call MD
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_MREMD
- include 'DIMENSIONS'
-#ifdef MPI
- include "mpif.h"
- include 'COMMON.SETUP'
- include 'COMMON.CONTROL'
- include 'COMMON.IOUNITS'
- include 'COMMON.REMD'
- if (me.eq.king .or. .not. out1file)
- & write (iout,*) "Calling chainbuild"
- call chainbuild
- if (me.eq.king .or. .not. out1file)
- & write (iout,*) "Calling REMD"
- if (remd_mlist) then
- call MREMD
- else
- do i=1,nrep
- remd_m(i)=1
- enddo
- call MREMD
- endif
-#else
- write (iout,*) "MREMD works on parallel machines only"
-#endif
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_eeval_or_minim
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.REMD'
- include 'COMMON.MD'
- include 'COMMON.SBRIDGE'
- common /srutu/ icall
- double precision energy(0:n_ene)
- double precision energy_long(0:n_ene),energy_short(0:n_ene)
- double precision varia(maxvar)
- if (indpdb.eq.0) call chainbuild
-#ifdef MPI
- time00=MPI_Wtime()
-#else
- time00=tcpu()
-#endif
- call chainbuild_cart
- if (split_ene) then
- print *,"Processor",myrank," after chainbuild"
- icall=1
- call etotal_long(energy_long(0))
- write (iout,*) "Printing long range energy"
- call enerprint(energy_long(0))
- call etotal_short(energy_short(0))
- write (iout,*) "Printing short range energy"
- call enerprint(energy_short(0))
- do i=0,n_ene
- energy(i)=energy_long(i)+energy_short(i)
- write (iout,*) i,energy_long(i),energy_short(i),energy(i)
- enddo
- write (iout,*) "Printing long+short range energy"
- call enerprint(energy(0))
- endif
- call etotal(energy(0))
-#ifdef MPI
- time_ene=MPI_Wtime()-time00
-#else
- time_ene=tcpu()-time00
-#endif
- write (iout,*) "Time for energy evaluation",time_ene
- print *,"after etotal"
- etota = energy(0)
- etot =etota
- call enerprint(energy(0))
- call hairpin(.true.,nharp,iharp)
- call secondary2(.true.)
- if (minim) then
-crc overlap test
- if (overlapsc) then
- print *, 'Calling OVERLAP_SC'
- call overlap_sc(fail)
- endif
-
- if (searchsc) then
- call sc_move(2,nres-1,10,1d10,nft_sc,etot)
- print *,'SC_move',nft_sc,etot
- write(iout,*) 'SC_move',nft_sc,etot
- endif
-
- if (dccart) then
- print *, 'Calling MINIM_DC'
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- call minim_dc(etot,iretcode,nfun)
- else
- if (indpdb.ne.0) then
- call bond_regular
- call chainbuild
- endif
- call geom_to_var(nvar,varia)
- print *,'Calling MINIMIZE.'
-#ifdef MPI
- time1=MPI_WTIME()
-#else
- time1=tcpu()
-#endif
- call minimize(etot,varia,iretcode,nfun)
- endif
- print *,'SUMSL return code is',iretcode,' eval ',nfun
-#ifdef MPI
- evals=nfun/(MPI_WTIME()-time1)
-#else
- evals=nfun/(tcpu()-time1)
-#endif
- print *,'# eval/s',evals
- print *,'refstr=',refstr
- call hairpin(.true.,nharp,iharp)
- call secondary2(.true.)
- call etotal(energy(0))
- etot = energy(0)
- call enerprint(energy(0))
-
- call intout
- call briefout(0,etot)
- if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- write (iout,'(a,i3)') 'SUMSL return code:',iretcode
- write (iout,'(a,i20)') '# of energy evaluations:',nfun+1
- write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals
- else
- print *,'refstr=',refstr
- if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- call briefout(0,etot)
- endif
- if (outpdb) call pdbout(etot,titel(:32),ipdb)
- if (outmol2) call mol2out(etot,titel(:32))
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_regularize
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.REMD'
- include 'COMMON.MD'
- include 'COMMON.SBRIDGE'
- double precision energy(0:n_ene)
-
- call gen_dist_constr
- call sc_conf
- call intout
- call regularize(nct-nnt+1,etot,rms,cref(1,nnt),iretcode)
- call etotal(energy(0))
- energy(0)=energy(0)-energy(14)
- etot=energy(0)
- call enerprint(energy(0))
- call intout
- call briefout(0,etot)
- if (outpdb) call pdbout(etot,titel(:32),ipdb)
- if (outmol2) call mol2out(etot,titel(:32))
- if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- write (iout,'(a,i3)') 'SUMSL return code:',iretcode
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_thread
- include 'DIMENSIONS'
-#ifdef MP
- include "mpif.h"
-#endif
- include "COMMON.SETUP"
- call thread_seq
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_MC
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- character*10 nodeinfo
- double precision varia(maxvar)
-#ifdef MPI
- include "mpif.h"
-#endif
- include "COMMON.SETUP"
- include 'COMMON.CONTROL'
- call mcm_setup
- if (minim) then
-#ifdef MPI
- if (modecalc.eq.3) then
- call do_mcm(ipar)
- else
- call entmcm
- endif
-#else
- if (modecalc.eq.3) then
- call do_mcm(ipar)
- else
- call entmcm
- endif
-#endif
- else
- call monte_carlo
- endif
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_mult_eeval_or_minim
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
- dimension muster(mpi_status_size)
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.REMD'
- include 'COMMON.MD'
- include 'COMMON.SBRIDGE'
- double precision varia(maxvar)
- dimension ind(6)
- double precision energy(0:n_ene)
- logical eof
- eof=.false.
-#ifdef MPI
- if(me.ne.king) then
- call minim_mcmf
- return
- endif
-
- close (intin)
- open(intin,file=intinname,status='old')
- write (istat,'(a5,30a12)')"# ",
- & (wname(print_order(i)),i=1,nprint_ene)
- if (refstr) then
- write (istat,'(a5,30a12)')"# ",
- & (ename(print_order(i)),i=1,nprint_ene),
- & "ETOT total","RMSD","nat.contact","nnt.contact","cont.order"
- else
- write (istat,'(a5,30a12)')"# ",
- & (ename(print_order(i)),i=1,nprint_ene),"ETOT total"
- endif
-
- if (.not.minim) then
- do while (.not. eof)
- if (read_cart) then
- read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene
- call read_x(intin,*11)
-#ifdef MPI
-c Broadcast the order to compute internal coordinates to the slaves.
- if (nfgtasks.gt.1)
- & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
- call int_from_cart1(.false.)
- else
- read (intin,'(i5)',end=1100,err=1100) iconf
- call read_angles(intin,*11)
- call geom_to_var(nvar,varia)
- call chainbuild
- endif
- write (iout,'(a,i7)') 'Conformation #',iconf
- call etotal(energy(0))
- call briefout(iconf,energy(0))
- call enerprint(energy(0))
- etot=energy(0)
- if (refstr) then
- call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- write (istat,'(i5,30(f12.3))') iconf,
- & (energy(print_order(i)),i=1,nprint_ene),etot,
- & rms,frac,frac_nn,co
-cjlee end
- else
- write (istat,'(i5,30(f12.3))') iconf,
- & (energy(print_order(i)),i=1,nprint_ene),etot
- endif
- enddo
-1100 continue
- goto 1101
- endif
-
- mm=0
- imm=0
- nft=0
- ene0=0.0d0
- n=0
- iconf=0
-c do n=1,nzsc
- do while (.not. eof)
- mm=mm+1
- if (mm.lt.nodes) then
- if (read_cart) then
- read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene
- call read_x(intin,*11)
-#ifdef MPI
-c Broadcast the order to compute internal coordinates to the slaves.
- if (nfgtasks.gt.1)
- & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
- call int_from_cart1(.false.)
- else
- read (intin,'(i5)',end=11,err=11) iconf
- call read_angles(intin,*11)
- call geom_to_var(nvar,varia)
- call chainbuild
- endif
-
- n=n+1
- write (iout,*) 'Conformation #',iconf,' read'
- imm=imm+1
- ind(1)=1
- ind(2)=n
- ind(3)=0
- ind(4)=0
- ind(5)=0
- ind(6)=0
- ene0=0.0d0
- call mpi_send(ind,6,mpi_integer,mm,idint,CG_COMM,
- * ierr)
- call mpi_send(varia,nvar,mpi_double_precision,mm,
- * idreal,CG_COMM,ierr)
- call mpi_send(ene0,1,mpi_double_precision,mm,
- * idreal,CG_COMM,ierr)
-c print *,'task ',n,' sent to worker ',mm,nvar
- else
- call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint,
- * CG_COMM,muster,ierr)
- man=muster(mpi_source)
-c print *,'receiving result from worker ',man,' (',iii1,iii,')'
- call mpi_recv(varia,nvar,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
- call mpi_recv(ene,1,
- * mpi_double_precision,man,idreal,
- * CG_COMM,muster,ierr)
- call mpi_recv(ene0,1,
- * mpi_double_precision,man,idreal,
- * CG_COMM,muster,ierr)
-c print *,'result received from worker ',man,' sending now'
-
- call var_to_geom(nvar,varia)
- call chainbuild
- call etotal(energy(0))
- iconf=ind(2)
- write (iout,*)
- write (iout,*)
- write (iout,*) 'Conformation #',iconf," sumsl return code ",
- & ind(5)
-
- etot=energy(0)
- call enerprint(energy(0))
- call briefout(it,etot)
-c if (minim) call briefout(it,etot)
- if (refstr) then
- call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- write (istat,'(i5,30(f12.3))') iconf,
- & (energy(print_order(i)),i=1,nprint_ene),etot,
- & rms,frac,frac_nn,co
- else
- write (istat,'(i5,30(f12.3))') iconf,
- & (energy(print_order(i)),i=1,nprint_ene),etot
- endif
-
- imm=imm-1
- if (read_cart) then
- read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene
- call read_x(intin,*11)
-#ifdef MPI
-c Broadcast the order to compute internal coordinates to the slaves.
- if (nfgtasks.gt.1)
- & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
- call int_from_cart1(.false.)
- else
- read (intin,'(i5)',end=11,err=11) iconf
- call read_angles(intin,*11)
- call geom_to_var(nvar,varia)
- call chainbuild
- endif
- n=n+1
- write (iout,*) 'Conformation #',iconf,' read'
- imm=imm+1
- ind(1)=1
- ind(2)=n
- ind(3)=0
- ind(4)=0
- ind(5)=0
- ind(6)=0
- call mpi_send(ind,6,mpi_integer,man,idint,CG_COMM,
- * ierr)
- call mpi_send(varia,nvar,mpi_double_precision,man,
- * idreal,CG_COMM,ierr)
- call mpi_send(ene0,1,mpi_double_precision,man,
- * idreal,CG_COMM,ierr)
- nf_mcmf=nf_mcmf+ind(4)
- nmin=nmin+1
- endif
- enddo
-11 continue
- do j=1,imm
- call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint,
- * CG_COMM,muster,ierr)
- man=muster(mpi_source)
- call mpi_recv(varia,nvar,mpi_double_precision,
- * man,idreal,CG_COMM,muster,ierr)
- call mpi_recv(ene,1,
- * mpi_double_precision,man,idreal,
- * CG_COMM,muster,ierr)
- call mpi_recv(ene0,1,
- * mpi_double_precision,man,idreal,
- * CG_COMM,muster,ierr)
-
- call var_to_geom(nvar,varia)
- call chainbuild
- call etotal(energy(0))
- iconf=ind(2)
- write (iout,*)
- write (iout,*)
- write (iout,*) 'Conformation #',iconf," sumsl return code ",
- & ind(5)
-
- etot=energy(0)
- call enerprint(energy(0))
- call briefout(it,etot)
- if (refstr) then
- call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- write (istat,'(i5,30(f12.3))') iconf,
- & (energy(print_order(i)),i=1,nprint_ene),etot,
- & rms,frac,frac_nn,co
- else
- write (istat,'(i5,30(f12.3))') iconf,
- & (energy(print_order(i)),i=1,nprint_ene),etot
- endif
- nmin=nmin+1
- enddo
-1101 continue
- do i=1, nodes-1
- ind(1)=0
- ind(2)=0
- ind(3)=0
- ind(4)=0
- ind(5)=0
- ind(6)=0
- call mpi_send(ind,6,mpi_integer,i,idint,CG_COMM,
- * ierr)
- enddo
-#else
- close (intin)
- open(intin,file=intinname,status='old')
- write (istat,'(a5,20a12)')"# ",
- & (wname(print_order(i)),i=1,nprint_ene)
- write (istat,'("# ",20(1pe12.4))')
- & (weights(print_order(i)),i=1,nprint_ene)
- if (refstr) then
- write (istat,'(a5,20a12)')"# ",
- & (ename(print_order(i)),i=1,nprint_ene),
- & "ETOT total","RMSD","nat.contact","nnt.contact"
- else
- write (istat,'(a5,14a12)')"# ",
- & (ename(print_order(i)),i=1,nprint_ene),"ETOT total"
- endif
- do while (.not. eof)
- if (read_cart) then
- read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene
- call read_x(intin,*11)
-#ifdef MPI
-c Broadcast the order to compute internal coordinates to the slaves.
- if (nfgtasks.gt.1)
- & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
-#endif
- call int_from_cart1(.false.)
- else
- read (intin,'(i5)',end=1100,err=1100) iconf
- call read_angles(intin,*11)
- call geom_to_var(nvar,varia)
- call chainbuild
- endif
- write (iout,'(a,i7)') 'Conformation #',iconf
- if (minim) call minimize(etot,varia,iretcode,nfun)
- call etotal(energy(0))
-
- etot=energy(0)
- call enerprint(energy(0))
- if (minim) call briefout(it,etot)
- if (refstr) then
- call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- write (istat,'(i5,18(f12.3))') iconf,
- & (energy(print_order(i)),i=1,nprint_ene),
- & etot,rms,frac,frac_nn,co
-cjlee end
- else
- write (istat,'(i5,14(f12.3))') iconf,
- & (energy(print_order(i)),i=1,nprint_ene),etot
- endif
- enddo
- 11 continue
- 1100 continue
-#endif
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_checkgrad
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
- include 'COMMON.SETUP'
- include 'COMMON.TIME1'
- include 'COMMON.INTERACT'
- include 'COMMON.NAMES'
- include 'COMMON.GEO'
- include 'COMMON.HEADER'
- include 'COMMON.CONTROL'
- include 'COMMON.CONTACTS'
- include 'COMMON.CHAIN'
- include 'COMMON.VAR'
- include 'COMMON.IOUNITS'
- include 'COMMON.FFIELD'
- include 'COMMON.REMD'
- include 'COMMON.MD'
- include 'COMMON.SBRIDGE'
- common /srutu/ icall
- double precision energy(0:max_ene)
-c do i=2,nres
-c vbld(i)=vbld(i)+ran_number(-0.1d0,0.1d0)
-c if (itype(i).ne.10)
-c & vbld(i+nres)=vbld(i+nres)+ran_number(-0.001d0,0.001d0)
-c enddo
- if (indpdb.eq.0) call chainbuild
-c do i=0,nres
-c do j=1,3
-c dc(j,i)=dc(j,i)+ran_number(-0.2d0,0.2d0)
-c enddo
-c enddo
-c do i=1,nres-1
-c if (itype(i).ne.10) then
-c do j=1,3
-c dc(j,i+nres)=dc(j,i+nres)+ran_number(-0.2d0,0.2d0)
-c enddo
-c endif
-c enddo
-c do j=1,3
-c dc(j,0)=ran_number(-0.2d0,0.2d0)
-c enddo
- usampl=.true.
- totT=1.d0
- eq_time=0.0d0
- call read_fragments
- read(inp,*) t_bath
- call rescale_weights(t_bath)
- call chainbuild_cart
- call cartprint
- call intout
- icall=1
- call etotal(energy(0))
- etot = energy(0)
- call enerprint(energy(0))
- write (iout,*) "Uconst",Uconst," Uconst_back",uconst_back
- print *,'icheckgrad=',icheckgrad
- goto (10,20,30) icheckgrad
- 10 call check_ecartint
- return
- 20 call check_cartgrad
- return
- 30 call check_eint
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_map
-C Energy maps
- call map_read
- call map
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_CSA
-#ifdef MPI
- include "mpif.h"
-#endif
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
-C Conformational Space Annealling programmed by Jooyoung Lee.
-C This method works only with parallel machines!
-#ifdef MPI
-csa call together
- write (iout,*) "CSA is not supported in this version"
-#else
-csa write (iout,*) "CSA works on parallel machines only"
- write (iout,*) "CSA is not supported in this version"
-#endif
- return
- end
-c---------------------------------------------------------------------------
- subroutine exec_softreg
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CONTROL'
- double precision energy(0:max_ene)
- logical debug /.false./
- call chainbuild
- call etotal(energy(0))
- call enerprint(energy(0))
- if (.not.lsecondary) then
- write(iout,*) 'Calling secondary structure recognition'
- call secondary2(debug)
- else
- write(iout,*) 'Using secondary structure supplied in pdb'
- endif
-
- call softreg
-
- call etotal(energy(0))
- etot=energy(0)
- call enerprint(energy(0))
- call intout
- call briefout(0,etot)
- call secondary2(.true.)
- if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- return
- end
+++ /dev/null
-../../lib/xdrf
\ No newline at end of file
enddo
endif
#endif
- call mpi_scatter(i2set,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
+c Corrected AL 8/19/2014: each processor needs whole iset array not only its
+c own element
+c call mpi_scatter(i2set,1,mpi_integer,
+c & iset,1,mpi_integer,king,
+c & CG_COMM,ierr)
+ call mpi_bcast(i2set(0),nodes,mpi_integer,king,
+ & CG_COMM,ierr)
+ iset=i2set(me)
endif
integer*2 i_index
& (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
common /przechowalnia/ d_restart1
+ integer i2set_(0:maxprocs)
write (*,*) "Processor",me," called read1restart"
if(me.eq.king)then
enddo
endif
#endif
- call mpi_scatter(i2set,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
-
+c Corrected AL 8/19/2014: each processor needs whole iset array not only its
+c own element
+c call mpi_scatter(i2set,1,mpi_integer,
+c & iset,1,mpi_integer,king,
+c & CG_COMM,ierr)
+ call mpi_bcast(i2set(0),nodes,mpi_integer,king,
+ & CG_COMM,ierr)
+ iset=i2set(me)
endif
-
if(me.eq.king) close(irest2)
return
end
integer*2 i_index
& (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200)
common /przechowalnia/ d_restart1
+ integer i2set_(0:maxprocs)
write (*,*) "Processor",me," called read1restart"
if(me.eq.king)then
enddo
endif
#endif
- call mpi_scatter(i2set,1,mpi_integer,
- & iset,1,mpi_integer,king,
- & CG_COMM,ierr)
-
+c Corrected AL 8/19/2014: each processor needs whole iset array not only its
+c own element
+c call mpi_scatter(i2set,1,mpi_integer,
+c & iset,1,mpi_integer,king,
+c & CG_COMM,ierr)
+ call mpi_bcast(i2set(0),nodes,mpi_integer,king,
+ & CG_COMM,ierr)
+ iset=i2set(me)
endif
-
if(me.eq.king) close(irest2)
return
end
projects / unres.git / commitdiff