|
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 00006 ! ***************************************************************************** 00014 MODULE molecule_types_new 00015 00016 USE colvar_types, ONLY: colvar_counters,& 00017 colvar_release,& 00018 colvar_type 00019 USE f77_blas 00020 USE kinds, ONLY: dp,& 00021 int_size 00022 USE molecule_kind_types, ONLY: colvar_constraint_type,& 00023 fixd_constraint_type,& 00024 g3x3_constraint_type,& 00025 g4x6_constraint_type,& 00026 molecule_kind_type,& 00027 vsite_constraint_type 00028 USE termination, ONLY: stop_memory,& 00029 stop_program 00030 #include "cp_common_uses.h" 00031 00032 IMPLICIT NONE 00033 00034 PRIVATE 00035 00036 ! *** Global parameters (in this module) *** 00037 00038 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'molecule_types_new' 00039 00040 ! *** Data types *** 00041 ! ***************************************************************************** 00042 TYPE local_colvar_constraint_type 00043 LOGICAL :: init 00044 TYPE(colvar_type),POINTER :: colvar 00045 TYPE(colvar_type),POINTER :: colvar_old 00046 REAL(KIND = dp) :: lambda, sigma 00047 END TYPE local_colvar_constraint_type 00048 00049 ! ***************************************************************************** 00050 TYPE local_g3x3_constraint_type 00051 LOGICAL :: init 00052 REAL(KIND = dp) :: scale,scale_old, imass1, imass2, imass3 00053 REAL(KIND = dp), DIMENSION(3) :: fa,fb,fc,f_roll1,f_roll2,f_roll3, 00054 ra_old,rb_old,rc_old, 00055 va,vb,vc,lambda, del_lambda, lambda_old, 00056 r0_12, r0_13, r0_23 00057 REAL(KIND = dp), DIMENSION(3,3) :: amat 00058 END TYPE local_g3x3_constraint_type 00059 00060 ! ***************************************************************************** 00061 TYPE local_g4x6_constraint_type 00062 LOGICAL :: init 00063 REAL(KIND = dp) :: scale,scale_old, imass1, imass2, imass3, imass4 00064 REAL(KIND = dp), DIMENSION(3) :: fa,fb,fc,fd,fe,ff, 00065 f_roll1, f_roll2, f_roll3, f_roll4, f_roll5, f_roll6, 00066 ra_old,rb_old,rc_old,rd_old,re_old,rf_old, 00067 va,vb,vc,vd,ve,vf, 00068 r0_12, r0_13, r0_14, r0_23, r0_24, r0_34 00069 REAL(KIND = dp), DIMENSION(6) :: lambda, del_lambda, lambda_old 00070 REAL(KIND = dp), DIMENSION(6,6) :: amat 00071 END TYPE local_g4x6_constraint_type 00072 00073 ! ***************************************************************************** 00074 TYPE local_molecule_type 00075 INTEGER, DIMENSION(:), POINTER :: states ! indices of Kohn-Sham states for molecule 00076 INTEGER :: nstates ! Kohn-Sham states for molecule 00077 END TYPE local_molecule_type 00078 00079 ! ***************************************************************************** 00080 TYPE local_constraint_type 00081 TYPE(local_colvar_constraint_type), DIMENSION ( : ) , POINTER :: lcolv 00082 TYPE(local_g3x3_constraint_type), DIMENSION ( : ) , POINTER :: lg3x3 00083 TYPE(local_g4x6_constraint_type), DIMENSION ( : ) , POINTER :: lg4x6 00084 END TYPE local_constraint_type 00085 00086 ! ***************************************************************************** 00087 TYPE global_constraint_type 00088 TYPE(colvar_counters) :: ncolv 00089 INTEGER :: ntot, nrestraint 00090 INTEGER :: ng3x3, ng3x3_restraint 00091 INTEGER :: ng4x6, ng4x6_restraint 00092 INTEGER :: nvsite, nvsite_restraint 00093 TYPE(fixd_constraint_type), DIMENSION(:), POINTER :: fixd_list 00094 TYPE(colvar_constraint_type), DIMENSION(:), POINTER :: colv_list 00095 TYPE(g3x3_constraint_type), DIMENSION(:), POINTER :: g3x3_list 00096 TYPE(g4x6_constraint_type), DIMENSION(:), POINTER :: g4x6_list 00097 TYPE(vsite_constraint_type), DIMENSION(:), POINTER :: vsite_list 00098 TYPE(local_colvar_constraint_type), DIMENSION ( : ) , POINTER :: lcolv 00099 TYPE(local_g3x3_constraint_type), DIMENSION ( : ) , POINTER :: lg3x3 00100 TYPE(local_g4x6_constraint_type), DIMENSION ( : ) , POINTER :: lg4x6 00101 END TYPE global_constraint_type 00102 00103 ! ***************************************************************************** 00104 TYPE molecule_type 00105 TYPE(molecule_kind_type), POINTER :: molecule_kind ! pointer to molecule kind information 00106 TYPE(local_molecule_type), POINTER :: lmi ! local molecule information 00107 TYPE(local_constraint_type), POINTER :: lci ! local molecule constraint info 00108 INTEGER :: first_atom ! global index of first atom in molecule 00109 INTEGER :: last_atom ! global index of last atom in molecule 00110 INTEGER :: first_shell ! global index of first shell atom in molecule 00111 INTEGER :: last_shell ! global index of last shell atom in molecule 00112 END TYPE molecule_type 00113 00114 ! *** Public data types *** 00115 00116 PUBLIC :: local_colvar_constraint_type,& 00117 local_g3x3_constraint_type,& 00118 local_g4x6_constraint_type,& 00119 local_constraint_type,& 00120 local_molecule_type,& 00121 global_constraint_type,& 00122 molecule_type 00123 00124 ! *** Public subroutines *** 00125 00126 PUBLIC :: allocate_molecule_set,& 00127 deallocate_molecule_set,& 00128 get_molecule,& 00129 set_molecule,& 00130 set_molecule_set,& 00131 molecule_of_atom 00132 00133 CONTAINS 00134 00135 ! ***************************************************************************** 00141 SUBROUTINE allocate_molecule_set(molecule_set,nmolecule,error) 00142 TYPE(molecule_type), DIMENSION(:), 00143 POINTER :: molecule_set 00144 INTEGER, INTENT(IN) :: nmolecule 00145 TYPE(cp_error_type), INTENT(inout) :: error 00146 00147 CHARACTER(len=*), PARAMETER :: routineN = 'allocate_molecule_set', 00148 routineP = moduleN//':'//routineN 00149 00150 INTEGER :: imolecule, istat 00151 00152 IF (ASSOCIATED(molecule_set)) CALL deallocate_molecule_set(molecule_set,error) 00153 00154 ALLOCATE (molecule_set(nmolecule),STAT=istat) 00155 IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,& 00156 "molecule_set",nmolecule*int_size) 00157 00158 DO imolecule=1,nmolecule 00159 NULLIFY (molecule_set(imolecule)%molecule_kind) 00160 NULLIFY (molecule_set(imolecule)%lmi) 00161 NULLIFY (molecule_set(imolecule)%lci) 00162 00163 molecule_set(imolecule)%first_atom = 0 00164 molecule_set(imolecule)%last_atom = 0 00165 molecule_set(imolecule)%first_shell = 0 00166 molecule_set(imolecule)%last_shell = 0 00167 END DO 00168 00169 END SUBROUTINE allocate_molecule_set 00170 00171 ! ***************************************************************************** 00177 SUBROUTINE deallocate_molecule_set(molecule_set,error) 00178 TYPE(molecule_type), DIMENSION(:), 00179 POINTER :: molecule_set 00180 TYPE(cp_error_type), INTENT(inout) :: error 00181 00182 CHARACTER(len=*), PARAMETER :: routineN = 'deallocate_molecule_set', 00183 routineP = moduleN//':'//routineN 00184 00185 INTEGER :: imolecule, istat, j 00186 00187 IF (ASSOCIATED(molecule_set)) THEN 00188 00189 DO imolecule=1,SIZE(molecule_set) 00190 IF (ASSOCIATED(molecule_set(imolecule)%lmi)) THEN 00191 IF (ASSOCIATED(molecule_set(imolecule)%lmi%states)) THEN 00192 DEALLOCATE (molecule_set(imolecule)%lmi%states,STAT=istat) 00193 IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,& 00194 "molecule_set(i)%lmi%states") 00195 ENDIF 00196 DEALLOCATE (molecule_set(imolecule)%lmi,STAT=istat) 00197 IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,& 00198 "molecule_set(i)%lmi") 00199 ENDIF 00200 IF (ASSOCIATED(molecule_set(imolecule)%lci)) THEN 00201 IF (ASSOCIATED(molecule_set(imolecule)%lci%lcolv)) THEN 00202 DO j = 1, SIZE(molecule_set(imolecule)%lci%lcolv) 00203 CALL colvar_release(molecule_set(imolecule)%lci%lcolv(j)%colvar,error=error) 00204 CALL colvar_release(molecule_set(imolecule)%lci%lcolv(j)%colvar_old,error=error) 00205 NULLIFY(molecule_set(imolecule)%lci%lcolv(j)%colvar) 00206 NULLIFY(molecule_set(imolecule)%lci%lcolv(j)%colvar_old) 00207 END DO 00208 DEALLOCATE (molecule_set(imolecule)%lci%lcolv,STAT=istat) 00209 IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,& 00210 "molecule_set(i)%lci%lcolv") 00211 ENDIF 00212 IF (ASSOCIATED(molecule_set(imolecule)%lci%lg3x3)) THEN 00213 DEALLOCATE (molecule_set(imolecule)%lci%lg3x3,STAT=istat) 00214 IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,& 00215 "molecule_set(i)%lci%lg3x3") 00216 ENDIF 00217 IF (ASSOCIATED(molecule_set(imolecule)%lci%lg4x6)) THEN 00218 DEALLOCATE (molecule_set(imolecule)%lci%lg4x6,STAT=istat) 00219 IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,& 00220 "molecule_set(i)%lci%lg4x6") 00221 ENDIF 00222 DEALLOCATE (molecule_set(imolecule)%lci,STAT=istat) 00223 IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,& 00224 "molecule_set(i)%lci") 00225 ENDIF 00226 ENDDO 00227 DEALLOCATE (molecule_set,STAT=istat) 00228 IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,& 00229 "molecule_set") 00230 00231 ELSE 00232 00233 CALL stop_program(routineN,moduleN,__LINE__,& 00234 "The pointer molecule_set is not associated and "//& 00235 "cannot be deallocated") 00236 00237 END IF 00238 00239 END SUBROUTINE deallocate_molecule_set 00240 00241 ! ***************************************************************************** 00247 SUBROUTINE get_molecule(molecule,molecule_kind,lmi,lg3x3,lg4x6,lcolv,& 00248 first_atom,last_atom,first_shell,last_shell) 00249 00250 TYPE(molecule_type), POINTER :: molecule 00251 TYPE(molecule_kind_type), OPTIONAL, 00252 POINTER :: molecule_kind 00253 TYPE(local_molecule_type), OPTIONAL, 00254 POINTER :: lmi 00255 TYPE(local_g3x3_constraint_type), 00256 OPTIONAL, POINTER :: lg3x3( : ) 00257 TYPE(local_g4x6_constraint_type), 00258 OPTIONAL, POINTER :: lg4x6( : ) 00259 TYPE(local_colvar_constraint_type), 00260 DIMENSION(:), OPTIONAL, POINTER :: lcolv 00261 INTEGER, OPTIONAL :: first_atom, last_atom, 00262 first_shell, last_shell 00263 00264 CHARACTER(len=*), PARAMETER :: routineN = 'get_molecule', 00265 routineP = moduleN//':'//routineN 00266 00267 IF (ASSOCIATED(molecule)) THEN 00268 00269 IF (PRESENT(first_atom)) first_atom = molecule%first_atom 00270 IF (PRESENT(last_atom)) last_atom = molecule%last_atom 00271 IF (PRESENT(first_shell)) first_shell = molecule%first_shell 00272 IF (PRESENT(last_shell)) last_shell = molecule%last_shell 00273 IF (PRESENT(molecule_kind)) molecule_kind => molecule%molecule_kind 00274 IF (PRESENT(lmi)) lmi => molecule%lmi 00275 IF ( PRESENT ( lcolv ) ) THEN 00276 IF ( ASSOCIATED ( molecule%lci ) ) THEN 00277 lcolv => molecule%lci%lcolv 00278 ELSE 00279 CALL stop_program(routineN,moduleN,__LINE__,& 00280 "The pointer lci is not associated") 00281 ENDIF 00282 ENDIF 00283 IF ( PRESENT ( lg3x3 ) ) THEN 00284 IF ( ASSOCIATED ( molecule%lci ) ) THEN 00285 lg3x3 => molecule%lci%lg3x3 00286 ELSE 00287 CALL stop_program(routineN,moduleN,__LINE__,& 00288 "The pointer lci is not associated") 00289 ENDIF 00290 ENDIF 00291 IF ( PRESENT ( lg4x6 ) ) THEN 00292 IF ( ASSOCIATED ( molecule%lci ) ) THEN 00293 lg4x6 => molecule%lci%lg4x6 00294 ELSE 00295 CALL stop_program(routineN,moduleN,__LINE__,& 00296 "The pointer lci is not associated") 00297 ENDIF 00298 ENDIF 00299 00300 ELSE 00301 00302 CALL stop_program(routineN,moduleN,__LINE__,& 00303 "The pointer lci is not associated") 00304 00305 END IF 00306 00307 END SUBROUTINE get_molecule 00308 00309 ! ***************************************************************************** 00315 SUBROUTINE set_molecule(molecule,molecule_kind,lmi,lci,lcolv,lg3x3,lg4x6) 00316 TYPE(molecule_type), POINTER :: molecule 00317 TYPE(molecule_kind_type), OPTIONAL, 00318 POINTER :: molecule_kind 00319 TYPE(local_molecule_type), OPTIONAL, 00320 POINTER :: lmi 00321 TYPE(local_constraint_type), OPTIONAL, 00322 POINTER :: lci 00323 TYPE(local_colvar_constraint_type), 00324 DIMENSION(:), OPTIONAL, POINTER :: lcolv 00325 TYPE(local_g3x3_constraint_type), 00326 OPTIONAL, POINTER :: lg3x3( : ) 00327 TYPE(local_g4x6_constraint_type), 00328 OPTIONAL, POINTER :: lg4x6( : ) 00329 00330 CHARACTER(len=*), PARAMETER :: routineN = 'set_molecule', 00331 routineP = moduleN//':'//routineN 00332 00333 IF (ASSOCIATED(molecule)) THEN 00334 00335 IF (PRESENT(molecule_kind)) molecule%molecule_kind => molecule_kind 00336 IF (PRESENT(lmi)) molecule%lmi => lmi 00337 IF (PRESENT(lci)) molecule%lci => lci 00338 IF (PRESENT(lcolv) ) THEN 00339 IF ( ASSOCIATED ( molecule%lci ) ) THEN 00340 molecule%lci%lcolv => lcolv 00341 ELSE 00342 CALL stop_program(routineN,moduleN,__LINE__,& 00343 "The pointer lci is not associated") 00344 ENDIF 00345 ENDIF 00346 IF (PRESENT(lg3x3)) THEN 00347 IF ( ASSOCIATED ( molecule%lci ) ) THEN 00348 molecule%lci%lg3x3 => lg3x3 00349 ELSE 00350 CALL stop_program(routineN,moduleN,__LINE__,& 00351 "The pointer lci is not associated") 00352 ENDIF 00353 ENDIF 00354 IF (PRESENT(lg4x6)) THEN 00355 IF ( ASSOCIATED ( molecule%lci ) ) THEN 00356 molecule%lci%lg4x6 => lg4x6 00357 ELSE 00358 CALL stop_program(routineN,moduleN,__LINE__,& 00359 "The pointer lci is not associated") 00360 ENDIF 00361 ENDIF 00362 ELSE 00363 00364 CALL stop_program(routineN,moduleN,__LINE__,& 00365 "The pointer molecule is not associated") 00366 00367 END IF 00368 00369 END SUBROUTINE set_molecule 00370 00371 ! ***************************************************************************** 00377 SUBROUTINE set_molecule_set(molecule_set,first_atom,last_atom) 00378 TYPE(molecule_type), DIMENSION(:), 00379 POINTER :: molecule_set 00380 INTEGER, DIMENSION(:), INTENT(IN), 00381 OPTIONAL :: first_atom, last_atom 00382 00383 CHARACTER(len=*), PARAMETER :: routineN = 'set_molecule_set', 00384 routineP = moduleN//':'//routineN 00385 00386 INTEGER :: imolecule 00387 00388 IF (ASSOCIATED(molecule_set)) THEN 00389 00390 IF (PRESENT(first_atom)) THEN 00391 00392 IF (SIZE(first_atom) /= SIZE(molecule_set)) THEN 00393 CALL stop_program(routineN,moduleN,__LINE__,& 00394 "The sizes of first_atom and molecule_set "//& 00395 "are different") 00396 END IF 00397 00398 DO imolecule=1,SIZE(molecule_set) 00399 molecule_set(imolecule)%first_atom = first_atom(imolecule) 00400 END DO 00401 00402 END IF 00403 00404 IF (PRESENT(last_atom)) THEN 00405 00406 IF (SIZE(last_atom) /= SIZE(molecule_set)) THEN 00407 CALL stop_program(routineN,moduleN,__LINE__,& 00408 "The sizes of last_atom and molecule_set "//& 00409 "are different") 00410 END IF 00411 00412 DO imolecule=1,SIZE(molecule_set) 00413 molecule_set(imolecule)%last_atom = last_atom(imolecule) 00414 END DO 00415 00416 END IF 00417 00418 ELSE 00419 00420 CALL stop_program(routineN,moduleN,__LINE__,& 00421 "The pointer molecule_set is not associated") 00422 00423 END IF 00424 00425 END SUBROUTINE set_molecule_set 00426 00427 ! ***************************************************************************** 00430 SUBROUTINE molecule_of_atom(molecule_set,atom_to_mol,error) 00431 TYPE(molecule_type), DIMENSION(:), 00432 POINTER :: molecule_set 00433 INTEGER, DIMENSION(:), INTENT(OUT) :: atom_to_mol 00434 TYPE(cp_error_type), INTENT(INOUT) :: error 00435 00436 CHARACTER(len=*), PARAMETER :: routineN = 'molecule_of_atom', 00437 routineP = moduleN//':'//routineN 00438 00439 INTEGER :: first_atom, iatom, imol, 00440 last_atom 00441 TYPE(molecule_type), POINTER :: molecule 00442 00443 DO imol = 1,SIZE(molecule_set) 00444 molecule => molecule_set(imol) 00445 CALL get_molecule ( molecule=molecule, first_atom = first_atom, last_atom = last_atom ) 00446 DO iatom = first_atom, last_atom 00447 atom_to_mol(iatom)=imol 00448 ENDDO ! iatom 00449 END DO ! imol 00450 00451 END SUBROUTINE molecule_of_atom 00452 00453 END MODULE molecule_types_new
1.7.3