assign_tortors Subroutine

public subroutine assign_tortors(bds, prm_buf)

Uses

  • proc~~assign_tortors~~UsesGraph proc~assign_tortors assign_tortors module~mod_bonded mod_bonded proc~assign_tortors->module~mod_bonded module~mod_memory mod_memory proc~assign_tortors->module~mod_memory module~mod_constants mod_constants proc~assign_tortors->module~mod_constants module~mod_bonded->module~mod_memory module~mod_io mod_io module~mod_bonded->module~mod_io module~mod_topology mod_topology module~mod_bonded->module~mod_topology module~mod_memory->module~mod_constants module~mod_memory->module~mod_io iso_c_binding iso_c_binding module~mod_memory->iso_c_binding module~mod_constants->iso_c_binding module~mod_io->module~mod_constants module~mod_topology->module~mod_memory module~mod_adjacency_mat mod_adjacency_mat module~mod_topology->module~mod_adjacency_mat module~mod_adjacency_mat->module~mod_memory

Arguments

Type IntentOptional Attributes Name
type(ommp_bonded_type), intent(inout) :: bds

Bonded potential data structure

character(len=OMMP_STR_CHAR_MAX), intent(in) :: prm_buf(:)

Char buffer containing the prm file loaded in RAM


Calls

proc~~assign_tortors~~CallsGraph proc~assign_tortors assign_tortors proc~read_atom_cards read_atom_cards proc~assign_tortors->proc~read_atom_cards proc~tokenize tokenize proc~assign_tortors->proc~tokenize interface~mallocate mallocate proc~assign_tortors->interface~mallocate proc~isint isint proc~assign_tortors->proc~isint proc~fatal_error fatal_error proc~assign_tortors->proc~fatal_error proc~isreal isreal proc~assign_tortors->proc~isreal proc~tortor_init tortor_init proc~assign_tortors->proc~tortor_init proc~tortor_newmap tortor_newmap proc~assign_tortors->proc~tortor_newmap interface~mfree mfree proc~assign_tortors->interface~mfree proc~read_atom_cards->proc~tokenize proc~read_atom_cards->interface~mallocate proc~read_atom_cards->proc~isint proc~read_atom_cards->proc~fatal_error proc~read_atom_cards->interface~mfree proc~count_substr_occurence count_substr_occurence proc~read_atom_cards->proc~count_substr_occurence proc~r_alloc1 r_alloc1 interface~mallocate->proc~r_alloc1 proc~r_alloc3 r_alloc3 interface~mallocate->proc~r_alloc3 proc~i_alloc2 i_alloc2 interface~mallocate->proc~i_alloc2 proc~i_alloc3 i_alloc3 interface~mallocate->proc~i_alloc3 proc~l_alloc2 l_alloc2 interface~mallocate->proc~l_alloc2 proc~i_alloc1 i_alloc1 interface~mallocate->proc~i_alloc1 proc~r_alloc2 r_alloc2 interface~mallocate->proc~r_alloc2 proc~l_alloc1 l_alloc1 interface~mallocate->proc~l_alloc1 proc~ommp_message ommp_message proc~fatal_error->proc~ommp_message proc~close_output close_output proc~fatal_error->proc~close_output proc~tortor_init->interface~mallocate proc~tortor_newmap->interface~mallocate proc~tortor_newmap->interface~mfree proc~cyclic_spline cyclic_spline proc~tortor_newmap->proc~cyclic_spline proc~r_free1 r_free1 interface~mfree->proc~r_free1 proc~i_free3 i_free3 interface~mfree->proc~i_free3 proc~r_free3 r_free3 interface~mfree->proc~r_free3 proc~i_free1 i_free1 interface~mfree->proc~i_free1 proc~i_free2 i_free2 interface~mfree->proc~i_free2 proc~l_free1 l_free1 interface~mfree->proc~l_free1 proc~l_free2 l_free2 interface~mfree->proc~l_free2 proc~r_free2 r_free2 interface~mfree->proc~r_free2 proc~chk_free chk_free proc~r_free1->proc~chk_free proc~i_free3->proc~chk_free proc~r_free3->proc~chk_free proc~chk_alloc chk_alloc proc~r_alloc1->proc~chk_alloc proc~memory_init memory_init proc~r_alloc1->proc~memory_init proc~r_alloc3->proc~chk_alloc proc~r_alloc3->proc~memory_init proc~i_alloc2->proc~chk_alloc proc~i_alloc2->proc~memory_init proc~i_alloc3->proc~chk_alloc proc~i_alloc3->proc~memory_init proc~l_alloc2->proc~chk_alloc proc~l_alloc2->proc~memory_init proc~cyclic_spline->interface~mallocate proc~cyclic_spline->interface~mfree dgetrf dgetrf proc~cyclic_spline->dgetrf dgetri dgetri proc~cyclic_spline->dgetri dgemm dgemm proc~cyclic_spline->dgemm proc~i_free1->proc~chk_free proc~i_free2->proc~chk_free proc~l_free1->proc~chk_free proc~i_alloc1->proc~chk_alloc proc~i_alloc1->proc~memory_init proc~r_alloc2->proc~chk_alloc proc~r_alloc2->proc~memory_init proc~l_alloc1->proc~chk_alloc proc~l_alloc1->proc~memory_init proc~close_output->proc~ommp_message proc~l_free2->proc~chk_free proc~r_free2->proc~chk_free proc~chk_free->proc~fatal_error proc~chk_alloc->proc~fatal_error

Called by

proc~~assign_tortors~~CalledByGraph proc~assign_tortors assign_tortors proc~mmpol_init_from_xyz mmpol_init_from_xyz proc~mmpol_init_from_xyz->proc~assign_tortors proc~ommp_system_from_qm_helper ommp_system_from_qm_helper proc~ommp_system_from_qm_helper->proc~assign_tortors proc~ommp_init_xyz ommp_init_xyz proc~ommp_init_xyz->proc~mmpol_init_from_xyz program~test_si_geomgrad test_SI_geomgrad program~test_si_geomgrad->proc~ommp_system_from_qm_helper program~test_si_geomgrad_num test_SI_geomgrad_num program~test_si_geomgrad_num->proc~ommp_system_from_qm_helper proc~c_ommp_system_from_qm_helper C_ommp_system_from_qm_helper proc~c_ommp_system_from_qm_helper->proc~ommp_system_from_qm_helper proc~c_ommp_init_xyz C_ommp_init_xyz proc~c_ommp_init_xyz->proc~ommp_init_xyz

Contents

Source Code


Source Code

    subroutine assign_tortors(bds, prm_buf)
        use mod_memory, only: mallocate, mfree
        use mod_bonded, only: tortor_newmap, tortor_init
        use mod_constants, only: deg2rad, kcalmol2au
        
        implicit none
        
        type(ommp_bonded_type), intent(inout) :: bds
        !! Bonded potential data structure
        character(len=OMMP_STR_CHAR_MAX), intent(in) :: prm_buf(:)
        !! Char buffer containing the prm file loaded in RAM

        integer(ip) :: il, i, j, tokb, toke, iprm, jd, je, e, d, cle,it,cld,&
                       cla, clb, clc, a, b, c, jc, jb, itt, ndata, ntt, ibeg, iend, maxtt
        character(len=OMMP_STR_CHAR_MAX) :: line, errstring
        integer(ip), allocatable :: classx(:,:), map_dimension(:,:), tmpat(:,:), tmpprm(:), savedmap(:)
        real(rp), allocatable :: data_map(:), ang_map(:,:)
        type(ommp_topology_type), pointer :: top

        top => bds%top

        if(.not. top%atclass_initialized .or. .not. top%atz_initialized) then
            call read_atom_cards(top, prm_buf)
        end if
        
        ! Read all the lines of file just to count how large vector should be 
        ! allocated
        ntt = 0
        do il=1, size(prm_buf) 
            line = prm_buf(il)
            if(line(:8) == 'tortors ') ntt = ntt + 1
        end do

        maxtt = top%conn(4)%ri(top%mm_atoms+1)-1 
        call mallocate('assign_tortors [classx]', 5, ntt, classx)
        call mallocate('assign_tortors [map_dimension]', 2, ntt, map_dimension)
        call mallocate('assign_tortors [savedmap]', ntt, savedmap)
        call mallocate('assign_tortors [tmpat]', 5, maxtt, tmpat)
        call mallocate('assign_tortors [tmpprm]', maxtt, tmpprm)

        ! Restart the reading from the beginning to actually save the parameters
        itt = 1
        i=1
        do il=1, size(prm_buf) 
            line = prm_buf(il)
           
            if(line(:8) == 'tortors ') then
                tokb = 9
                toke = tokenize(line, tokb)
                if(.not. isint(line(tokb:toke))) then
                    write(errstring, *) "Wrong TORTORS card"
                    call fatal_error(errstring)
                end if
                read(line(tokb:toke), *) classx(1,itt)
                
                tokb = toke+1
                toke = tokenize(line, tokb)
                if(.not. isint(line(tokb:toke))) then
                    write(errstring, *) "Wrong TORTORS card"
                    call fatal_error(errstring)
                end if
                read(line(tokb:toke), *) classx(2,itt)
        
                tokb = toke+1
                toke = tokenize(line, tokb)
                if(.not. isint(line(tokb:toke))) then
                    write(errstring, *) "Wrong TORTORS card"
                    call fatal_error(errstring)
                end if
                read(line(tokb:toke), *) classx(3,itt)
        
                tokb = toke+1
                toke = tokenize(line, tokb)
                if(.not. isint(line(tokb:toke))) then
                    write(errstring, *) "Wrong TORTORS card"
                    call fatal_error(errstring)
                end if
                read(line(tokb:toke), *) classx(4,itt)
        
                tokb = toke+1
                toke = tokenize(line, tokb)
                if(.not. isint(line(tokb:toke))) then
                    write(errstring, *) "Wrong TORTORS card"
                    call fatal_error(errstring)
                end if
                read(line(tokb:toke), *) classx(5,itt)

                tokb = toke+1
                toke = tokenize(line, tokb)
                if(.not. isint(line(tokb:toke))) then
                    write(errstring, *) "Wrong TORTORS card"
                    call fatal_error(errstring)
                end if
                read(line(tokb:toke), *) map_dimension(1,itt)
                
                tokb = toke+1
                toke = tokenize(line, tokb)
                if(.not. isint(line(tokb:toke))) then
                    write(errstring, *) "Wrong TORTORS card"
                    call fatal_error(errstring)
                end if
                read(line(tokb:toke), *) map_dimension(2,itt)
                
                itt = itt + 1
            end if
            i = i+1
        end do

        ! Allocate data space and finally read the map
        ndata = dot_product(map_dimension(1,:), map_dimension(2,:))
        call mallocate('assign_tortors [data_map]', ndata, data_map)
        call mallocate('assign_tortors [ang_map]', 2, ndata, ang_map)
        
        itt = 1
        i=1
        do il=1, size(prm_buf) 
            line = prm_buf(il)
           
            if(line(:8) == 'tortors ') then
                ndata = map_dimension(1,itt)*map_dimension(2,itt)
                do j=1, ndata
                    line = prm_buf(il+j)
                    
                    tokb = tokenize(line)
                    toke = tokenize(line, tokb)
                    if(.not. isreal(line(tokb:toke))) then
                        write(errstring, *) "Wrong TORTORS data card"
                        call fatal_error(errstring)
                    end if
                    read(line(tokb:toke), *) ang_map(1, i)
                    
                    tokb = toke+1
                    toke = tokenize(line, tokb)
                    if(.not. isreal(line(tokb:toke))) then
                        write(errstring, *) "Wrong TORTORS data card"
                        call fatal_error(errstring)
                    end if
                    read(line(tokb:toke), *) ang_map(2, i)
                    
                    tokb = toke+1
                    toke = tokenize(line, tokb)
                    if(.not. isreal(line(tokb:toke))) then
                        write(errstring, *) "Wrong TORTORS data card"
                        call fatal_error(errstring)
                    end if
                    read(line(tokb:toke), *) data_map(i)
                    i = i + 1
                end do
                itt = itt + 1
            end if
        end do
        
        it = 1
        do a=1, top%mm_atoms
            cla = top%atclass(a)
            do jb=top%conn(1)%ri(a), top%conn(1)%ri(a+1)-1
                b = top%conn(1)%ci(jb)
                clb = top%atclass(b)
                do jc=top%conn(1)%ri(b), top%conn(1)%ri(b+1)-1
                    c = top%conn(1)%ci(jc)
                    if(c == a) cycle
                    clc = top%atclass(c)
                    do jd=top%conn(1)%ri(c), top%conn(1)%ri(c+1)-1
                        d = top%conn(1)%ci(jd)
                        if(d == a .or. d == b) cycle
                        cld = top%atclass(d)
                        do je=top%conn(1)%ri(d), top%conn(1)%ri(d+1)-1
                            e = top%conn(1)%ci(je)
                            if(e == a .or. e == b .or. e == c) cycle
                            if(a > e) cycle
                            cle = top%atclass(e)
                            ! There is a dihedral pair A-B-C-D-E
                            do iprm=1, ntt
                                if((classx(1,iprm) == cla .and. &
                                    classx(2,iprm) == clb .and. &
                                    classx(3,iprm) == clc .and. &
                                    classx(4,iprm) == cld .and. &
                                    classx(5,iprm) == cle) .or. &
                                   (classx(1,iprm) == cle .and. &
                                    classx(2,iprm) == cld .and. &
                                    classx(3,iprm) == clc .and. &
                                    classx(4,iprm) == clb .and. &
                                    classx(5,iprm) == cla)) then
                                    ! The parameter is ok
                                    tmpat(:,it) = [a, b, c, d, e]
                                    tmpprm(it) = iprm
                                    it = it+1
                                    exit
                                end if
                            end do
                        end do
                    end do
                end do
            end do
        end do
        
        call tortor_init(bds, it-1)
        savedmap = -1
        iprm = 1
        do i=1, it-1
            if(savedmap(tmpprm(i)) < 0) then
                ! If needed, save the map in the module
                ibeg = 1 
                do j=1, tmpprm(i)-1
                    ibeg = ibeg + map_dimension(1,j)*map_dimension(2,j)
                end do
                iend = ibeg + map_dimension(1,tmpprm(i))*map_dimension(2,tmpprm(i)) - 1
                call tortor_newmap(bds, map_dimension(1,tmpprm(i)), &
                                   map_dimension(2,tmpprm(i)), &
                                   ang_map(1,ibeg:iend) * deg2rad, &
                                   ang_map(2,ibeg:iend) * deg2rad, &
                                   data_map(ibeg:iend) * kcalmol2au)
                savedmap(tmpprm(i)) = iprm
                iprm = iprm + 1
            end if

            bds%tortorat(:,i) = tmpat(:,i)
            bds%tortorprm(i) = savedmap(tmpprm(i))
        end do

        call mfree('assign_tortors [classx]', classx)
        call mfree('assign_tortors [map_dimension]', map_dimension)
        call mfree('assign_tortors [savedmap]', savedmap)
        call mfree('assign_tortors [data_map]', data_map)
        call mfree('assign_tortors [ang_map]', ang_map)
        call mfree('assign_tortors [tmpat]', tmpat)
        call mfree('assign_tortors [tmpprm]', tmpprm)
    
    end subroutine assign_tortors