|
CP2K 2.4 (Revision 12889)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular dynamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 ! ***************************************************************************** 00010 MODULE sap_kind_types 00011 00012 USE kinds, ONLY: dp 00013 USE util, ONLY: locate,& 00014 sort 00015 #include "cp_common_uses.h" 00016 00017 IMPLICIT NONE 00018 00019 PRIVATE 00020 00021 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'sap_kind_types' 00022 00023 TYPE clist_type 00024 INTEGER :: catom, nsgf_cnt 00025 INTEGER, DIMENSION(:), POINTER :: sgf_list 00026 INTEGER, DIMENSION(3) :: cell 00027 LOGICAL :: sgf_soft_only 00028 REAL(KIND = dp) :: maxac, maxach 00029 REAL(KIND = dp), DIMENSION(3) :: rac 00030 REAL(KIND = dp), DIMENSION(:,:,:), POINTER :: acint 00031 REAL(KIND = dp), DIMENSION(:,:,:), POINTER :: achint 00032 END TYPE clist_type 00033 00034 TYPE alist_type 00035 INTEGER :: aatom 00036 INTEGER :: nclist 00037 TYPE(clist_type), DIMENSION(:), POINTER :: clist 00038 END TYPE alist_type 00039 00040 TYPE sap_int_type 00041 INTEGER :: a_kind, p_kind 00042 INTEGER :: nalist 00043 TYPE(alist_type), DIMENSION(:), POINTER :: alist 00044 INTEGER, DIMENSION(:), POINTER :: asort, aindex 00045 END TYPE sap_int_type 00046 00047 PUBLIC :: sap_int_type, clist_type, alist_type,& 00048 release_sap_int, get_alist, alist_pre_align_blk,& 00049 alist_post_align_blk, sap_sort 00050 00051 CONTAINS 00052 00053 !========================================================================================================== 00054 00055 SUBROUTINE release_sap_int(sap_int, error) 00056 00057 TYPE(sap_int_type), DIMENSION(:), 00058 POINTER :: sap_int 00059 TYPE(cp_error_type), INTENT(inout) :: error 00060 00061 CHARACTER(LEN=*), PARAMETER :: routineN = 'release_sap_int', 00062 routineP = moduleN//':'//routineN 00063 00064 INTEGER :: i, j, k, stat 00065 LOGICAL :: failure = .FALSE. 00066 TYPE(clist_type), POINTER :: clist 00067 00068 CPPrecondition(ASSOCIATED(sap_int),cp_failure_level,routineP,error,failure) 00069 00070 DO i=1,SIZE(sap_int) 00071 IF ( ASSOCIATED(sap_int(i)%alist) ) THEN 00072 DO j=1,SIZE(sap_int(i)%alist) 00073 IF ( ASSOCIATED(sap_int(i)%alist(j)%clist) ) THEN 00074 DO k=1,SIZE(sap_int(i)%alist(j)%clist) 00075 clist => sap_int(i)%alist(j)%clist(k) 00076 IF ( ASSOCIATED(clist%acint) ) THEN 00077 DEALLOCATE (clist%acint,STAT=stat) 00078 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00079 END IF 00080 IF ( ASSOCIATED(clist%sgf_list) ) THEN 00081 DEALLOCATE (clist%sgf_list,STAT=stat) 00082 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00083 END IF 00084 IF ( ASSOCIATED(clist%achint) ) THEN 00085 DEALLOCATE (clist%achint,STAT=stat) 00086 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00087 END IF 00088 END DO 00089 DEALLOCATE (sap_int(i)%alist(j)%clist,STAT=stat) 00090 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00091 END IF 00092 END DO 00093 DEALLOCATE (sap_int(i)%alist,STAT=stat) 00094 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00095 END IF 00096 IF ( ASSOCIATED(sap_int(i)%asort) ) THEN 00097 DEALLOCATE (sap_int(i)%asort,STAT=stat) 00098 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00099 END IF 00100 IF ( ASSOCIATED(sap_int(i)%aindex) ) THEN 00101 DEALLOCATE (sap_int(i)%aindex,STAT=stat) 00102 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00103 END IF 00104 END DO 00105 00106 DEALLOCATE (sap_int,STAT=stat) 00107 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00108 00109 END SUBROUTINE release_sap_int 00110 00111 SUBROUTINE get_alist(sap_int, alist, atom, error) 00112 00113 TYPE(sap_int_type) :: sap_int 00114 TYPE(alist_type), POINTER :: alist 00115 INTEGER, INTENT(IN) :: atom 00116 TYPE(cp_error_type), INTENT(inout) :: error 00117 00118 CHARACTER(LEN=*), PARAMETER :: routineN = 'get_alist', 00119 routineP = moduleN//':'//routineN 00120 00121 INTEGER :: i 00122 LOGICAL :: failure = .FALSE. 00123 00124 NULLIFY(alist) 00125 i = locate(sap_int%asort,atom) 00126 IF (i > 0 .AND. i <= SIZE(sap_int%alist)) THEN 00127 i = sap_int%aindex(i) 00128 alist => sap_int%alist(i) 00129 ELSE IF (i==0) THEN 00130 NULLIFY(alist) 00131 ELSE 00132 CPPrecondition(.FALSE.,cp_failure_level,routineP,error,failure) 00133 END IF 00134 00135 END SUBROUTINE get_alist 00136 00137 SUBROUTINE alist_pre_align_blk(blk_in,ldin,blk_out,ldout,ilist,in,jlist,jn) 00138 INTEGER :: ldin 00139 REAL(dp) :: blk_in(ldin,*) 00140 INTEGER :: ldout 00141 REAL(dp) :: blk_out(ldout,*) 00142 INTEGER :: ilist(*), in, jlist(*), jn 00143 00144 INTEGER :: i, i0, i1, i2, i3, inn, inn1, 00145 j, j0 00146 00147 inn = MOD(in,4) 00148 inn1 = inn+1 00149 DO j = 1,jn 00150 j0 = jlist(j) 00151 DO i = 1,inn 00152 i0 = ilist(i) 00153 blk_out(i,j) = blk_in(i0,j0) 00154 ENDDO 00155 DO i = inn1,in,4 00156 i0 = ilist(i) 00157 i1 = ilist(i+1) 00158 i2 = ilist(i+2) 00159 i3 = ilist(i+3) 00160 blk_out(i ,j) = blk_in(i0,j0) 00161 blk_out(i+1,j) = blk_in(i1,j0) 00162 blk_out(i+2,j) = blk_in(i2,j0) 00163 blk_out(i+3,j) = blk_in(i3,j0) 00164 ENDDO 00165 ENDDO 00166 END SUBROUTINE alist_pre_align_blk 00167 00168 SUBROUTINE alist_post_align_blk(blk_in,ldin,blk_out,ldout,ilist,in,jlist,jn) 00169 INTEGER :: ldin 00170 REAL(dp) :: blk_in(ldin,*) 00171 INTEGER :: ldout 00172 REAL(dp) :: blk_out(ldout,*) 00173 INTEGER :: ilist(*), in, jlist(*), jn 00174 00175 INTEGER :: i, i0, i1, i2, i3, inn, inn1, 00176 j, j0 00177 00178 inn = MOD(in,4) 00179 inn1 = inn+1 00180 DO j = 1,jn 00181 j0 = jlist(j) 00182 DO i = 1,inn 00183 i0 = ilist(i) 00184 blk_out(i0,j0) = blk_out(i0,j0) + blk_in(i,j) 00185 ENDDO 00186 DO i = inn1,in,4 00187 i0 = ilist(i) 00188 i1 = ilist(i+1) 00189 i2 = ilist(i+2) 00190 i3 = ilist(i+3) 00191 blk_out(i0,j0) = blk_out(i0,j0) + blk_in(i ,j) 00192 blk_out(i1,j0) = blk_out(i1,j0) + blk_in(i+1,j) 00193 blk_out(i2,j0) = blk_out(i2,j0) + blk_in(i+2,j) 00194 blk_out(i3,j0) = blk_out(i3,j0) + blk_in(i+3,j) 00195 ENDDO 00196 ENDDO 00197 END SUBROUTINE alist_post_align_blk 00198 00199 SUBROUTINE sap_sort(sap_int,error) 00200 TYPE(sap_int_type), DIMENSION(:), 00201 POINTER :: sap_int 00202 TYPE(cp_error_type), INTENT(inout) :: error 00203 00204 CHARACTER(LEN=*), PARAMETER :: routineN = 'sap_sort', 00205 routineP = moduleN//':'//routineN 00206 00207 INTEGER :: iac, na, stat 00208 LOGICAL :: failure = .FALSE. 00209 00210 ! *** Set up a sorting index 00211 00212 DO iac=1,SIZE(sap_int) 00213 IF (.NOT.ASSOCIATED(sap_int(iac)%alist)) CYCLE 00214 na = SIZE(sap_int(iac)%alist) 00215 ALLOCATE(sap_int(iac)%asort(na),sap_int(iac)%aindex(na),STAT=stat) 00216 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00217 sap_int(iac)%asort(1:na)=sap_int(iac)%alist(1:na)%aatom 00218 CALL sort(sap_int(iac)%asort,na,sap_int(iac)%aindex) 00219 END DO 00220 00221 END SUBROUTINE sap_sort 00222 00223 !========================================================================================================== 00224 00225 END MODULE sap_kind_types
1.7.3