Merge branch 'devel' into UCGM
[unres4.git] / source / unres / control.F90
index f45a88e..38ac803 100644 (file)
 !      enddo !iblock
 
 !      do i=1,maxres
-!      itype(i)=0
+!      itype(i,1)=0
 !      itel(i)=0
 !      enddo
 ! Initialize the bridge arrays
             ind_scpint_old,nsumgrad,nlen,ngrad_start,ngrad_end,&
             ierror,k,ierr,iaux,ncheck_to,ncheck_from,ind_typ,&
             ichunk,int_index_old
-
+      integer,dimension(5) :: nct_molec
 !el      allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
 !el      allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
 
        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)
+       iatsc_s,iatsc_e,jj+1,nct_molec(1),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
+            iend(i,2)=nct_molec(1)
 #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)
+          iatsc_s,iatsc_e,i+1,nct_molec(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
-          ind_scint=ind_scint+nct-i
+          iend(i,1)=nct_molec(1)
+          ind_scint=ind_scint+nct_molec(1)-i
 #endif
         endif
 #ifdef MPI
       ispp=4 !?? wham ispp=2
 #ifdef MPI
 ! Now partition the electrostatic-interaction array
-      npept=nct-nnt
+      if (itype(nres_molec(1),1).eq.ntyp1_molec(1)) then
+      npept=nres_molec(1)-nnt-1
+      else
+      npept=nres_molec(1)-nnt
+      endif
       nele_int_tot=(npept-ispp)*(npept-ispp+1)/2
       call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde)
       if (lprint) &
       iatel_e=0
       ind_eleint=0
       ind_eleint_old=0
-      do i=nnt,nct-3
+      if (itype(nres_molec(1),1).eq.ntyp1_molec(1)) then
+      nct_molec(1)=nres_molec(1)-1
+      else
+      nct_molec(1)=nres_molec(1)
+      endif
+!       print *,"nct",nct,nct_molec(1),itype(nres_molec(1),1),ntyp_molec(1)
+      do i=nnt,nct_molec(1)-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)
+          iatel_s,iatel_e,i+ispp,nct_molec(1)-1,ijunk,ielstart(i),ielend(i),*13)
       enddo ! i 
    13 continue
       if (iatel_s.eq.0) iatel_s=1
       ind_eleint_vdw_old=0
       iatel_s_vdw=0
       iatel_e_vdw=0
-      do i=nnt,nct-3
+      do i=nnt,nct_molec(1)-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),&
+          iatel_s_vdw,iatel_e_vdw,i+2,nct_molec(1)-1,ijunk,ielstart_vdw(i),&
           ielend_vdw(i),*15)
 !        write (iout,*) i," ielstart_vdw",ielstart_vdw(i),
 !     &   " ielend_vdw",ielend_vdw(i)
    15 continue
 #else
       iatel_s=nnt
-      iatel_e=nct-5 ! ?? wham iatel_e=nct-3
+      iatel_e=nct_molec(1)-5 ! ?? wham iatel_e=nct-3
       do i=iatel_s,iatel_e
         ielstart(i)=i+4 ! ?? wham +2
-        ielend(i)=nct-1
+        ielend(i)=nct_molec(1)-1
       enddo
       iatel_s_vdw=nnt
-      iatel_e_vdw=nct-3
+      iatel_e_vdw=nct_molec(1)-3
       do i=iatel_s_vdw,iatel_e_vdw
         ielstart_vdw(i)=i+2
-        ielend_vdw(i)=nct-1
+        ielend_vdw(i)=nct_molec(1)-1
       enddo
 #endif
       if (lprint) then
       iatscp_e=0
       ind_scpint=0
       ind_scpint_old=0
-      do i=nnt,nct-1
+      do i=nnt,nct_molec(1)-1
         if (i.lt.nnt+iscp) then
 !d        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),&
+            iatscp_s,iatscp_e,i+iscp,nct_molec(1),nscp_gr(i),iscpstart(i,1),&
             iscpend(i,1),*14)
         else if (i.gt.nct-iscp) then
 !d        write (iout,*) 'i.gt.nct-iscp'
            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),&
+            iatscp_s,iatscp_e,i+iscp,nct_molec(1),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
+      iatscp_e=nct_molec(1)-1
+      do i=nnt,nct_molec(1)-1
         if (i.lt.nnt+iscp) then
           nscp_gr(i)=1
           iscpstart(i,1)=i+iscp
-          iscpend(i,1)=nct
+          iscpend(i,1)=nct_molec(1)
         elseif (i.gt.nct-iscp) then
           nscp_gr(i)=1
           iscpstart(i,1)=nnt
           iscpstart(i,1)=nnt
           iscpend(i,1)=i-iscp
           iscpstart(i,2)=i+iscp
-          iscpend(i,2)=nct
+          iscpend(i,2)=nct_molec(1)
         endif 
       enddo ! i
 #endif
       endif ! lprint
 ! Partition local interactions
 #ifdef MPI
-      call int_bounds(nres-2,loc_start,loc_end)
+      call int_bounds(nres_molec(1)-2,loc_start,loc_end)
       loc_start=loc_start+1
       loc_end=loc_end+1
-      call int_bounds(nres-2,ithet_start,ithet_end)
+      call int_bounds(nres_molec(1)-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) 
+      call int_bounds(nct_molec(1)-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)
+      call int_bounds(nres_molec(1)-3,itau_start,itau_end)
       itau_start=itau_start+3
       itau_end=itau_end+3
-      call int_bounds(nres-3,iphi1_start,iphi1_end)
+      call int_bounds(nres_molec(1)-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) 
+      call int_bounds(nct_molec(1)-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) 
+!      print *,"TUTUTU",nres_molec(1),nres
+      call int_bounds(nres_molec(1)-2,ibond_start,ibond_end) 
       ibond_start=ibond_start+1
       ibond_end=ibond_end+1
-      call int_bounds(nct-nnt,ibondp_start,ibondp_end) 
+      print *,ibond_start,ibond_end
+      call int_bounds(nct_molec(1)-nnt,ibondp_start,ibondp_end) 
       ibondp_start=ibondp_start+nnt
       ibondp_end=ibondp_end+nnt
-      call int_bounds1(nres-1,ivec_start,ivec_end) 
+      call int_bounds1(nres_molec(1)-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
-      call int_bounds(nres,ilip_start,ilip_end)
+      call int_bounds(nres_molec(1),ilip_start,ilip_end)
       ilip_start=ilip_start
       ilip_end=ilip_end
-      call int_bounds(nres-1,itube_start,itube_end)
+      call int_bounds(nres_molec(1)-1,itube_start,itube_end)
       itube_start=itube_start
       itube_end=itube_end
       if (ndih_constr.eq.0) then
       else
         call int_bounds(ndih_constr,idihconstr_start,idihconstr_end)
       endif
+      if (ntheta_constr.eq.0) then
+        ithetaconstr_start=1
+        ithetaconstr_end=0
+      else
+        call int_bounds &
+       (ntheta_constr,ithetaconstr_start,ithetaconstr_end)
+      endif
+
 !      nsumgrad=(nres-nnt)*(nres-nnt+1)/2
 !      nlen=nres-nnt+1
       nsumgrad=(nres-nnt)*(nres-nnt+1)/2
       endif
 #else
       loc_start=2
-      loc_end=nres-1
+      loc_end=nres_molec(1)-1
       ithet_start=3 
-      ithet_end=nres
+      ithet_end=nres_molec(1)
       iturn3_start=nnt
-      iturn3_end=nct-3
+      iturn3_end=nct_molec(1)-3
       iturn4_start=nnt
-      iturn4_end=nct-4
+      iturn4_end=nct_molec(1)-4
       iphi_start=nnt+3
-      iphi_end=nct
+      iphi_end=nct_molec(1)
       iphi1_start=4
-      iphi1_end=nres
+      iphi1_end=nres_molec(1)
       idihconstr_start=1
       idihconstr_end=ndih_constr
+      ithetaconstr_start=1
+      ithetaconstr_end=ntheta_constr
       iphid_start=iphi_start
       iphid_end=iphi_end-1
       itau_start=4
-      itau_end=nres
+      itau_end=nres_molec(1)
       ibond_start=2
-      ibond_end=nres-1
+      ibond_end=nres_molec(1)-1
       ibondp_start=nnt
-      ibondp_end=nct-1
+      ibondp_end=nct_molec(1)-1
       ivec_start=1
-      ivec_end=nres-1
+      ivec_end=nres_molec(1)-1
       iset_start=3
-      iset_end=nres+1
+      iset_end=nres_molec(1)+1
       iint_start=2
-      iint_end=nres-1
+      iint_end=nres_molec(1)-1
       ilip_start=1
-      ilip_end=nres
+      ilip_end=nres_molec(1)
       itube_start=1
-      itube_end=nres
+      itube_end=nres_molec(1)
 #endif
 !el       common /przechowalnia/
 !      deallocate(iturn3_start_all)
       nside=0
       do i=2,nres-1
 #ifdef WHAM_RUN
-        if (itype(i).ne.10) then
+        if (itype(i,1).ne.10) then
 #else
-        if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then
+        if (itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
 #endif
          nside=nside+1
           ialph(i,1)=nvar+nside
 !-----------------------------------------------------------------------------
 ! rescode.f
 !-----------------------------------------------------------------------------
-      integer function rescode(iseq,nam,itype)
+      integer function rescode(iseq,nam,itype,molecule)
 
       use io_base, only: ucase
 !      implicit real*8 (a-h,o-z)
 !      include 'COMMON.IOUNITS'
       character(len=3) :: nam  !,ucase
       integer :: iseq,itype,i
-
+      integer :: molecule
+      print *,molecule,nam
+      if (molecule.eq.1) then 
       if (itype.eq.0) then
 
-      do i=-ntyp1,ntyp1
-        if (ucase(nam).eq.restyp(i)) then
+      do i=-ntyp1_molec(molecule),ntyp1_molec(molecule)
+        if (ucase(nam).eq.restyp(i,molecule)) then
           rescode=i
           return
         endif
 
       else
 
-      do i=-ntyp1,ntyp1
+      do i=-ntyp1_molec(molecule),ntyp1_molec(molecule)
         if (nam(1:1).eq.onelet(i)) then
           rescode=i
           return  
       enddo
 
       endif
+      else if (molecule.eq.2) then
+      do i=1,ntyp1_molec(molecule)
+         print *,nam(1:1),restyp(i,molecule)(1:1) 
+        if (nam(1:1).eq.restyp(i,molecule)(1:1)) then
+          rescode=i
+          return
+        endif
+      enddo
+      else if (molecule.eq.3) then
+       write(iout,*) "SUGAR not yet implemented"
+       stop
+      else if (molecule.eq.4) then
+       write(iout,*) "Explicit LIPID not yet implemented"
+       stop
+      else if (molecule.eq.5) then
+      do i=1,ntyp1_molec(molecule)
+        print *,i,restyp(i,molecule)
+        if (ucase(nam).eq.restyp(i,molecule)) then
+          rescode=i
+          return
+        endif
+      enddo
+      else   
+       write(iout,*) "molecule not defined"
+      endif
       write (iout,10) iseq,nam
       stop
    10 format ('**** Error - residue',i4,' has an unresolved name ',a3)
       end function rescode
+      integer function sugarcode(sugar,ires)
+      character sugar
+      integer ires
+      if (sugar.eq.'D') then
+        sugarcode=1
+      else if (sugar.eq.' ') then
+        sugarcode=2
+      else
+        write (iout,*) 'UNKNOWN sugar type for residue',ires,' ',sugar
+        stop
+      endif
+      return
+      end function sugarcode
+
 !-----------------------------------------------------------------------------
 ! timing.F
 !-----------------------------------------------------------------------------