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