added source code
[unres.git] / source / wham / src-M / readrtns_compar.F
1       subroutine read_compar
2 C
3 C Read molecular data
4 C
5       implicit none
6       include 'DIMENSIONS'
7       include 'DIMENSIONS.ZSCOPT'
8       include 'DIMENSIONS.COMPAR'
9       include 'DIMENSIONS.FREE'
10       include 'COMMON.IOUNITS'
11       include 'COMMON.TIME1'
12       include 'COMMON.SBRIDGE'
13       include 'COMMON.CONTROL'
14       include 'COMMON.COMPAR'
15       include 'COMMON.CHAIN'
16       include 'COMMON.HEADER'
17       include 'COMMON.GEO'
18       include 'COMMON.FREE'
19       character*320 controlcard,ucase
20       character*64 wfile
21       integer ilen
22       external ilen
23       integer i,j,k
24
25       call card_concat(controlcard,.true.)
26       pdbref=(index(controlcard,'PDBREF').gt.0)
27       call reada(controlcard,'CUTOFF_UP',rmscut_base_up,4.0d0)
28       call reada(controlcard,'CUTOFF_LOW',rmscut_base_low,3.0d0)
29       call reada(controlcard,'RMSUP_LIM',rmsup_lim,4.0d0)
30       call reada(controlcard,'RMSUPUP_LIM',rmsupup_lim,7.5d0)
31       verbose = index(controlcard,"VERBOSE").gt.0
32       lgrp=index(controlcard,"STATIN").gt.0
33       lgrp_out=index(controlcard,"STATOUT").gt.0
34       merge_helices=index(controlcard,"DONT_MERGE_HELICES").eq.0
35       binary = index(controlcard,"BINARY").gt.0
36       rmscut_base_up=rmscut_base_up/50
37       rmscut_base_low=rmscut_base_low/50
38       call reada(controlcard,"FRAC_SEC",frac_sec,0.66666666d0)
39       call readi(controlcard,'NLEVEL',nlevel,1)
40       if (nlevel.lt.0) goto 121
41 c Read the data pertaining to elementary fragments (level 1)
42       call readi(controlcard,'NFRAG',nfrag(1),0)
43       write(iout,*)"nfrag(1)",nfrag(1)
44       do j=1,nfrag(1)
45         call card_concat(controlcard,.true.)
46         write (iout,*) controlcard(:ilen(controlcard))
47         call readi(controlcard,'NPIECE',npiece(j,1),0)
48         call readi(controlcard,'N_SHIFT1',n_shift(1,j,1),0)
49         call readi(controlcard,'N_SHIFT2',n_shift(2,j,1),0)
50         call reada(controlcard,'ANGCUT',ang_cut(j),50.0d0)
51         call reada(controlcard,'MAXANG',ang_cut1(j),360.0d0)
52         call reada(controlcard,'FRAC_MIN',frac_min(j),0.666666d0)
53         call reada(controlcard,'NC_FRAC',nc_fragm(j,1),0.5d0)
54         call readi(controlcard,'NC_REQ',nc_req_setf(j,1),0)
55         call readi(controlcard,'RMS',irms(j,1),0)
56         call readi(controlcard,'LOCAL',iloc(j),1)
57         call readi(controlcard,'ELCONT',ielecont(j,1),1)
58         if (ielecont(j,1).eq.0) then
59           call readi(controlcard,'SCCONT',isccont(j,1),1)
60         endif
61         ang_cut(j)=ang_cut(j)*deg2rad
62         ang_cut1(j)=ang_cut1(j)*deg2rad
63         do k=1,npiece(j,1)
64           call card_concat(controlcard,.true.)
65           call readi(controlcard,'IFRAG1',ifrag(1,k,j),0)
66           call readi(controlcard,'IFRAG2',ifrag(2,k,j),0)
67         enddo
68         write(iout,*)"j",j," npiece",npiece(j,1)," ifrag",
69      &    (ifrag(1,k,j),ifrag(2,k,j),
70      &   k=1,npiece(j,1))," ang_cut",ang_cut(j)*rad2deg,
71      &    " ang_cut1",ang_cut1(j)*rad2deg
72         write(iout,*)"n_shift",n_shift(1,j,1),n_shift(2,j,1)
73         write(iout,*)"nc_frac",nc_fragm(j,1)," nc_req",nc_req_setf(j,1)
74         write(iout,*)"irms",irms(j,1)," ielecont",ielecont(j,1),
75      &    " ilocal",iloc(j)," isccont",isccont(j,1)
76       enddo
77 c Read data pertaning to higher levels
78       do i=2,nlevel
79         call card_concat(controlcard,.true.)
80         call readi(controlcard,'NFRAG',NFRAG(i),0)
81         write (iout,*) "i",i," nfrag",nfrag(i)
82         do j=1,nfrag(i)
83           call card_concat(controlcard,.true.)
84           if (i.eq.2) then
85             call readi(controlcard,'ELCONT',ielecont(j,i),0)
86             if (ielecont(j,i).eq.0) then
87               call readi(controlcard,'SCCONT',isccont(j,i),1)
88             endif
89             call readi(controlcard,'RMS',irms(j,i),0)
90           else
91             ielecont(j,i)=0
92             isccont(j,i)=0
93             irms(j,i)=1
94           endif
95           call readi(controlcard,'NPIECE',npiece(j,i),0)
96           call readi(controlcard,'N_SHIFT1',n_shift(1,j,i),0)
97           call readi(controlcard,'N_SHIFT2',n_shift(2,j,i),0)
98           call multreadi(controlcard,'IPIECE',ipiece(1,j,i),
99      &      npiece(j,i),0)
100           call reada(controlcard,'NC_FRAC',nc_fragm(j,i),0.5d0)
101           call readi(controlcard,'NC_REQ',nc_req_setf(j,i),0)
102           write(iout,*) "j",j," npiece",npiece(j,i)," n_shift",
103      &      n_shift(1,j,i),n_shift(2,j,i)," ielecont",ielecont(j,i),
104      &      " isccont",isccont(j,i)," irms",irms(j,i)
105           write(iout,*) "ipiece",(ipiece(k,j,i),k=1,npiece(j,i))
106           write(iout,*)"n_shift",n_shift(1,j,i),n_shift(2,j,i)
107           write(iout,*)"nc_frac",nc_fragm(j,i),
108      &     " nc_req",nc_req_setf(j,i)
109         enddo
110       enddo
111       if (binary) write (iout,*) "Classes written in binary format."
112       return
113   121 continue
114       call reada(controlcard,'ANGCUT_HEL',angcut_hel,50.0d0)
115       call reada(controlcard,'MAXANG_HEL',angcut1_hel,60.0d0)
116       call reada(controlcard,'ANGCUT_BET',angcut_bet,90.0d0)
117       call reada(controlcard,'MAXANG_BET',angcut1_bet,360.0d0)
118       call reada(controlcard,'ANGCUT_STRAND',angcut_strand,90.0d0)
119       call reada(controlcard,'MAXANG_STRAND',angcut1_strand,60.0d0)
120       call reada(controlcard,'FRAC_MIN',frac_min_set,0.666666d0)
121       call reada(controlcard,'NC_FRAC_HEL',ncfrac_hel,0.5d0)
122       call readi(controlcard,'NC_REQ_HEL',ncreq_hel,0)
123       call reada(controlcard,'NC_FRAC_BET',ncfrac_bet,0.5d0)
124       call reada(controlcard,'NC_FRAC_PAIR',ncfrac_pair,0.3d0)
125       call readi(controlcard,'NC_REQ_BET',ncreq_bet,0)
126       call readi(controlcard,'NC_REQ_PAIR',ncreq_pair,0)
127       call readi(controlcard,'NSHIFT_HEL',nshift_hel,3)
128       call readi(controlcard,'NSHIFT_BET',nshift_bet,3)
129       call readi(controlcard,'NSHIFT_STRAND',nshift_strand,3)
130       call readi(controlcard,'NSHIFT_PAIR',nshift_pair,3)
131       call readi(controlcard,'RMS_SINGLE',irms_single,0)
132       call readi(controlcard,'CONT_SINGLE',icont_single,1)
133       call readi(controlcard,'LOCAL_SINGLE',iloc_single,1)
134       call readi(controlcard,'RMS_PAIR',irms_pair,0)
135       call readi(controlcard,'CONT_PAIR',icont_pair,1)
136       call readi(controlcard,'SPLIT_BET',isplit_bet,0)
137       angcut_hel=angcut_hel*deg2rad
138       angcut1_hel=angcut1_hel*deg2rad
139       angcut_bet=angcut_bet*deg2rad
140       angcut1_bet=angcut1_bet*deg2rad
141       angcut_strand=angcut_strand*deg2rad
142       angcut1_strand=angcut1_strand*deg2rad
143       write (iout,*) "Automatic detection of structural elements"
144       write (iout,*) 'NC_FRAC_HEL',ncfrac_hel,' NC_REQ_HEL',ncreq_hel,
145      &               ' NC_FRAC_BET',ncfrac_bet,' NC_REQ_BET',ncreq_bet,
146      &           ' RMS_SINGLE',irms_single,' CONT_SINGLE',icont_single,
147      &           ' NC_FRAC_PAIR',ncfrac_pair,' NC_REQ_PAIR',ncreq_pair,
148      &  ' RMS_PAIR',irms_pair,' CONT_PAIR',icont_pair,
149      &  ' SPLIT_BET',isplit_bet
150       write (iout,*) 'NSHIFT_HEL',nshift_hel,' NSHIFT_BET',nshift_bet,
151      &  ' NSHIFT_STRAND',nshift_strand,' NSHIFT_PAIR',nshift_pair
152       write (iout,*) 'ANGCUT_HEL',angcut_hel*rad2deg,
153      &  ' MAXANG_HEL',angcut1_hel*rad2deg
154       write (iout,*) 'ANGCUT_BET',angcut_bet*rad2deg,
155      &               ' MAXANG_BET',angcut1_bet*rad2deg
156       write (iout,*) 'ANGCUT_STRAND',angcut_strand*rad2deg,
157      &               ' MAXANG_STRAND',angcut1_strand*rad2deg
158       write (iout,*) 'FRAC_MIN',frac_min_set
159       return
160       end