CP2K 2.4 (Revision 12889)

fist_environment_types.f90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------------!
00002 !   CP2K: A general program to perform molecular dynamics simulations         !
00003 !   Copyright (C) 2000 - 2013  CP2K developers group                          !
00004 !-----------------------------------------------------------------------------!
00005 
00006 ! *****************************************************************************
00013 MODULE fist_environment_types
00014   USE atomic_kind_list_types,          ONLY: atomic_kind_list_create,&
00015                                              atomic_kind_list_release,&
00016                                              atomic_kind_list_type
00017   USE atomic_kind_types,               ONLY: atomic_kind_type
00018   USE cell_types,                      ONLY: cell_release,&
00019                                              cell_retain,&
00020                                              cell_type
00021   USE cp_para_env,                     ONLY: cp_para_env_release,&
00022                                              cp_para_env_retain
00023   USE cp_para_types,                   ONLY: cp_para_env_type
00024   USE cp_result_types,                 ONLY: cp_result_create,&
00025                                              cp_result_release,&
00026                                              cp_result_type
00027   USE cp_subsys_types,                 ONLY: cp_subsys_create,&
00028                                              cp_subsys_get,&
00029                                              cp_subsys_release,&
00030                                              cp_subsys_retain,&
00031                                              cp_subsys_set,&
00032                                              cp_subsys_type
00033   USE distribution_1d_types,           ONLY: distribution_1d_type
00034   USE ewald_environment_types,         ONLY: ewald_env_release,&
00035                                              ewald_env_retain,&
00036                                              ewald_environment_type
00037   USE ewald_pw_types,                  ONLY: ewald_pw_release,&
00038                                              ewald_pw_retain,&
00039                                              ewald_pw_type
00040   USE exclusion_types,                 ONLY: exclusion_release,&
00041                                              exclusion_type
00042   USE f77_blas
00043   USE fist_energy_types,               ONLY: deallocate_fist_energy,&
00044                                              fist_energy_type
00045   USE fist_nonbond_env_types,          ONLY: fist_nonbond_env_release,&
00046                                              fist_nonbond_env_retain,&
00047                                              fist_nonbond_env_type
00048   USE input_section_types,             ONLY: section_vals_release,&
00049                                              section_vals_retain,&
00050                                              section_vals_type
00051   USE mol_kind_new_list_types,         ONLY: mol_kind_new_list_create,&
00052                                              mol_kind_new_list_release,&
00053                                              mol_kind_new_list_type
00054   USE mol_new_list_types,              ONLY: mol_new_list_create,&
00055                                              mol_new_list_release,&
00056                                              mol_new_list_type
00057   USE molecule_kind_types,             ONLY: molecule_kind_type
00058   USE molecule_types_new,              ONLY: molecule_type
00059   USE multipole_types,                 ONLY: multipole_type
00060   USE particle_list_types,             ONLY: particle_list_create,&
00061                                              particle_list_release,&
00062                                              particle_list_type
00063   USE particle_types,                  ONLY: particle_type
00064   USE qmmm_types,                      ONLY: qmmm_env_mm_create,&
00065                                              qmmm_env_mm_release,&
00066                                              qmmm_env_mm_retain,&
00067                                              qmmm_env_mm_type
00068 #include "cp_common_uses.h"
00069 
00070   IMPLICIT NONE
00071   PRIVATE
00072 
00073 ! *****************************************************************************
00078   TYPE fist_environment_type
00079     PRIVATE
00080     INTEGER                                      :: id_nr, ref_count
00081     LOGICAL                                      :: qmmm
00082     LOGICAL                                      :: shell_model, shell_model_ad
00083     TYPE (qmmm_env_mm_type), POINTER             :: qmmm_env
00084     TYPE (cell_type), POINTER                    :: cell
00085     TYPE (cell_type), POINTER                    :: cell_ref
00086     TYPE (ewald_environment_type), POINTER       :: ewald_env
00087     TYPE (ewald_pw_type),          POINTER       :: ewald_pw
00088     TYPE (fist_energy_type), POINTER             :: thermo
00089     TYPE (cp_para_env_type), POINTER             :: para_env
00090     TYPE (cp_subsys_type), POINTER               :: subsys
00091     TYPE (fist_nonbond_env_type), POINTER        :: fist_nonbond_env
00092     TYPE(section_vals_type), POINTER             :: input
00093     TYPE(cp_result_type),POINTER                 :: results
00094     TYPE(exclusion_type), DIMENSION(:), POINTER  :: exclusions
00095  END TYPE fist_environment_type
00096 
00097 ! *****************************************************************************
00104   TYPE fist_environment_p_type
00105      TYPE(fist_environment_type), POINTER :: fist_env
00106   END TYPE fist_environment_p_type
00107 
00108 ! *** Public data types ***
00109   PUBLIC :: fist_environment_type,&
00110             fist_environment_p_type,&
00111             exclusion_type
00112 
00113 ! *** Public subroutines ***
00114   PUBLIC :: fist_env_get,&
00115             init_fist_env,&
00116             fist_env_set,&
00117             fist_env_create,&
00118             fist_env_release,&
00119             fist_env_retain
00120 
00121   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'fist_environment_types'
00122   INTEGER, PRIVATE, SAVE :: last_fist_env_id_nr=0
00123 
00124 !***
00125 
00126 CONTAINS
00127 
00128 ! *****************************************************************************
00135   SUBROUTINE fist_env_get( fist_env, atomic_kind_set, particle_set, ewald_pw,  &
00136        local_particles, local_molecules, molecule_kind_set, molecule_set, cell,&
00137        cell_ref, ewald_env, fist_nonbond_env, thermo, para_env, subsys, qmmm,&
00138        qmmm_env, input, shell_model, shell_model_ad, shell_particle_set,&
00139        core_particle_set, multipoles, results, exclusions, error )
00140 
00141     TYPE(fist_environment_type), INTENT(IN)  :: fist_env
00142     TYPE(atomic_kind_type), OPTIONAL, 
00143       POINTER                                :: atomic_kind_set( : )
00144     TYPE(particle_type), OPTIONAL, POINTER   :: particle_set( : )
00145     TYPE(ewald_pw_type), OPTIONAL, POINTER   :: ewald_pw
00146     TYPE(distribution_1d_type), OPTIONAL, 
00147       POINTER                                :: local_particles, 
00148                                                 local_molecules
00149     TYPE(molecule_kind_type), OPTIONAL, 
00150       POINTER                                :: molecule_kind_set( : )
00151     TYPE(molecule_type), OPTIONAL, POINTER   :: molecule_set( : )
00152     TYPE(cell_type), OPTIONAL, POINTER       :: cell, cell_ref
00153     TYPE(ewald_environment_type), OPTIONAL, 
00154       POINTER                                :: ewald_env
00155     TYPE(fist_nonbond_env_type), OPTIONAL, 
00156       POINTER                                :: fist_nonbond_env
00157     TYPE(fist_energy_type), OPTIONAL, 
00158       POINTER                                :: thermo
00159     TYPE(cp_para_env_type), OPTIONAL, 
00160       POINTER                                :: para_env
00161     TYPE(cp_subsys_type), OPTIONAL, POINTER  :: subsys
00162     LOGICAL, OPTIONAL                        :: qmmm
00163     TYPE(qmmm_env_mm_type), OPTIONAL, 
00164       POINTER                                :: qmmm_env
00165     TYPE(section_vals_type), OPTIONAL, 
00166       POINTER                                :: input
00167     LOGICAL, OPTIONAL                        :: shell_model, shell_model_ad
00168     TYPE(particle_type), OPTIONAL, POINTER   :: shell_particle_set( : ), 
00169                                                 core_particle_set( : )
00170     TYPE(multipole_type), OPTIONAL, POINTER  :: multipoles
00171     TYPE(cp_result_type), OPTIONAL, POINTER  :: results
00172     TYPE(exclusion_type), DIMENSION(:), 
00173       OPTIONAL, POINTER                      :: exclusions
00174     TYPE(cp_error_type), INTENT(INOUT)       :: error
00175 
00176     CHARACTER(len=*), PARAMETER :: routineN = 'fist_env_get', 
00177       routineP = moduleN//':'//routineN
00178 
00179     LOGICAL                                  :: failure
00180     TYPE(atomic_kind_list_type), POINTER     :: atomic_kinds
00181     TYPE(mol_kind_new_list_type), POINTER    :: molecule_kinds_new
00182     TYPE(mol_new_list_type), POINTER         :: molecules_new
00183     TYPE(multipole_type), POINTER            :: fist_multipoles
00184     TYPE(particle_list_type), POINTER        :: core_particles, particles, 
00185                                                 shell_particles
00186 
00187     failure=.FALSE.
00188     NULLIFY( atomic_kinds, particles, molecules_new, molecule_kinds_new, fist_multipoles)
00189     CPPrecondition(ASSOCIATED(fist_env%subsys),cp_failure_level,routineP,error,failure)
00190 
00191     IF ( PRESENT ( input ) ) input => fist_env%input
00192     IF ( PRESENT ( qmmm ) ) qmmm = fist_env % qmmm
00193     IF ( PRESENT ( qmmm_env )) qmmm_env => fist_env % qmmm_env
00194     IF ( PRESENT ( cell ) ) cell => fist_env % cell
00195     IF ( PRESENT ( cell_ref ) ) cell_ref => fist_env % cell_ref
00196     IF ( PRESENT ( ewald_env ) ) ewald_env => fist_env % ewald_env
00197     IF ( PRESENT ( thermo ) ) thermo => fist_env % thermo
00198     IF ( PRESENT ( exclusions ) ) exclusions => fist_env % exclusions
00199     IF ( PRESENT ( para_env ) ) para_env => fist_env % para_env
00200     IF ( PRESENT ( ewald_pw ) ) ewald_pw => fist_env % ewald_pw
00201     IF ( PRESENT ( fist_nonbond_env ) ) fist_nonbond_env => fist_env % fist_nonbond_env
00202     IF ( PRESENT ( shell_model ) ) shell_model = fist_env % shell_model
00203     IF ( PRESENT ( shell_model_ad ) ) shell_model_ad = fist_env % shell_model_ad
00204     IF (PRESENT(subsys)) subsys => fist_env%subsys
00205     CALL cp_subsys_get(fist_env%subsys,&
00206                       atomic_kinds=atomic_kinds,&
00207                       local_molecules_new=local_molecules,&
00208                       local_particles=local_particles,&
00209                       particles=particles,&
00210                       molecule_kinds_new=molecule_kinds_new,&
00211                       molecules_new=molecules_new,&
00212                       shell_particles=shell_particles,&
00213                       core_particles=core_particles,&
00214                       multipoles=fist_multipoles,&
00215                       error=error)
00216     IF (PRESENT(atomic_kind_set)) atomic_kind_set => atomic_kinds%els
00217     IF (PRESENT(particle_set)) particle_set => particles%els
00218     IF (PRESENT(molecule_kind_set)) molecule_kind_set => molecule_kinds_new%els
00219     IF (PRESENT(molecule_set)) molecule_set => molecules_new%els
00220     IF (PRESENT(shell_particle_set)) shell_particle_set => shell_particles%els
00221     IF (PRESENT(core_particle_set)) core_particle_set => core_particles%els
00222     IF (PRESENT(results)) results => fist_env%results
00223     IF (PRESENT(multipoles)) multipoles => fist_multipoles
00224   END SUBROUTINE fist_env_get
00225 
00226 ! *****************************************************************************
00233   SUBROUTINE init_fist_env ( fist_env, para_env, error )
00234 
00235     TYPE(fist_environment_type), INTENT(OUT) :: fist_env
00236     TYPE(cp_para_env_type), POINTER          :: para_env
00237     TYPE(cp_error_type), INTENT(inout)       :: error
00238 
00239     NULLIFY (fist_env%input)
00240     NULLIFY (fist_env%cell)
00241     NULLIFY (fist_env%qmmm_env)
00242     NULLIFY (fist_env%cell_ref)
00243     NULLIFY (fist_env%ewald_env)
00244     NULLIFY (fist_env%ewald_pw)
00245     NULLIFY (fist_env%thermo)
00246     NULLIFY (fist_env%fist_nonbond_env)
00247     NULLIFY (fist_env%subsys)
00248     NULLIFY (fist_env%exclusions)
00249     fist_env % qmmm = .FALSE.
00250     fist_env % shell_model = .FALSE.
00251     fist_env % shell_model_ad = .FALSE.
00252     CALL qmmm_env_mm_create(fist_env%qmmm_env, error)
00253     CALL cp_subsys_create(fist_env%subsys, para_env=para_env, error=error)
00254     CALL cp_result_create(results=fist_env%results,error=error)
00255     CALL cp_para_env_retain(para_env,error=error)
00256     fist_env%para_env => para_env
00257     fist_env%ref_count=1
00258     last_fist_env_id_nr=last_fist_env_id_nr+1
00259     fist_env%id_nr=last_fist_env_id_nr
00260 
00261   END SUBROUTINE init_fist_env
00262 
00263 ! *****************************************************************************
00270   SUBROUTINE fist_env_set( fist_env, atomic_kind_set, particle_set, ewald_pw, &
00271                            local_particles, local_molecules, molecule_kind_set, &
00272                            molecule_set, cell, cell_ref, ewald_env,  &
00273                            fist_nonbond_env, thermo, subsys, qmmm, qmmm_env, &
00274                            input, shell_model, shell_model_ad, exclusions, error )
00275 
00276     TYPE(fist_environment_type), POINTER     :: fist_env
00277     TYPE(atomic_kind_type), OPTIONAL, 
00278       POINTER                                :: atomic_kind_set( : )
00279     TYPE(particle_type), OPTIONAL, POINTER   :: particle_set( : )
00280     TYPE(ewald_pw_type), OPTIONAL, POINTER   :: ewald_pw
00281     TYPE(distribution_1d_type), OPTIONAL, 
00282       POINTER                                :: local_particles, 
00283                                                 local_molecules
00284     TYPE(molecule_kind_type), OPTIONAL, 
00285       POINTER                                :: molecule_kind_set( : )
00286     TYPE(molecule_type), OPTIONAL, POINTER   :: molecule_set( : )
00287     TYPE(cell_type), OPTIONAL, POINTER       :: cell, cell_ref
00288     TYPE(ewald_environment_type), OPTIONAL, 
00289       POINTER                                :: ewald_env
00290     TYPE(fist_nonbond_env_type), OPTIONAL, 
00291       POINTER                                :: fist_nonbond_env
00292     TYPE(fist_energy_type), OPTIONAL, 
00293       POINTER                                :: thermo
00294     TYPE(cp_subsys_type), OPTIONAL, POINTER  :: subsys
00295     LOGICAL, OPTIONAL                        :: qmmm
00296     TYPE(qmmm_env_mm_type), OPTIONAL, 
00297       POINTER                                :: qmmm_env
00298     TYPE(section_vals_type), OPTIONAL, 
00299       POINTER                                :: input
00300     LOGICAL, OPTIONAL                        :: shell_model, shell_model_ad
00301     TYPE(exclusion_type), DIMENSION(:), 
00302       OPTIONAL, POINTER                      :: exclusions
00303     TYPE(cp_error_type), INTENT(INOUT)       :: error
00304 
00305     CHARACTER(len=*), PARAMETER :: routineN = 'fist_env_set', 
00306       routineP = moduleN//':'//routineN
00307 
00308     LOGICAL                                  :: failure
00309     TYPE(atomic_kind_list_type), POINTER     :: atomic_kinds
00310     TYPE(mol_kind_new_list_type), POINTER    :: molecule_kinds_new
00311     TYPE(mol_new_list_type), POINTER         :: molecules_new
00312     TYPE(particle_list_type), POINTER        :: particles
00313 
00314     failure=.FALSE.
00315     CPPrecondition(fist_env%ref_count>0,cp_failure_level,routineP,error,failure)
00316 
00317     IF (PRESENT(qmmm)) fist_env%qmmm = qmmm
00318     IF (PRESENT(qmmm_env)) THEN
00319        CALL qmmm_env_mm_retain(qmmm_env, error)
00320        CALL qmmm_env_mm_release(fist_env%qmmm_env, error=error)
00321        fist_env%qmmm_env => qmmm_env
00322     END IF
00323     IF (PRESENT(cell)) THEN
00324        CALL cell_retain(cell, error=error)
00325        CALL cell_release(fist_env%cell,error=error)
00326        fist_env%cell => cell
00327     END IF
00328     IF ( PRESENT ( ewald_env ) ) THEN
00329        CALL ewald_env_retain ( ewald_env, error = error )
00330        CALL ewald_env_release ( fist_env % ewald_env, error = error )
00331        fist_env % ewald_env => ewald_env
00332     ENDIF
00333     IF ( PRESENT ( ewald_pw ) ) THEN
00334        CALL ewald_pw_retain ( ewald_pw, error = error )
00335        CALL ewald_pw_release ( fist_env % ewald_pw, error = error )
00336        fist_env % ewald_pw => ewald_pw
00337     ENDIF
00338     IF (PRESENT(cell_ref)) THEN
00339        CALL cell_retain(cell_ref, error=error)
00340        CALL cell_release(fist_env%cell_ref,error=error)
00341        fist_env%cell_ref => cell_ref
00342     END IF
00343     IF ( PRESENT ( fist_nonbond_env ) ) THEN
00344        CALL fist_nonbond_env_retain ( fist_nonbond_env, error )
00345        CALL fist_nonbond_env_release ( fist_env % fist_nonbond_env, error )
00346        fist_env % fist_nonbond_env => fist_nonbond_env
00347     ENDIF
00348     IF (PRESENT(input)) THEN
00349        CALL section_vals_retain(input,error=error)
00350        CALL section_vals_release(fist_env%input,error=error)
00351        fist_env%input => input
00352     END IF
00353     IF ( PRESENT ( thermo ) ) fist_env % thermo => thermo
00354     IF (PRESENT(subsys)) THEN
00355        CALL cp_subsys_retain(subsys,error=error)
00356        CALL cp_subsys_release(fist_env%subsys,error=error)
00357        fist_env%subsys => subsys
00358     END IF
00359     IF (PRESENT(atomic_kind_set)) THEN
00360       CALL atomic_kind_list_create(atomic_kinds,&
00361                                    els_ptr=atomic_kind_set,&
00362                                    error=error)
00363       CALL cp_subsys_set(fist_env%subsys,&
00364                         atomic_kinds=atomic_kinds,&
00365                         error=error)
00366       CALL atomic_kind_list_release(atomic_kinds,error=error)
00367     END IF
00368     IF (PRESENT(particle_set)) THEN
00369       CALL particle_list_create(particles,&
00370                                 els_ptr=particle_set,&
00371                                 error=error)
00372       CALL cp_subsys_set(fist_env%subsys,&
00373                         particles=particles,&
00374                         error=error)
00375       CALL particle_list_release(particles,error=error)
00376     END IF
00377     IF (PRESENT(local_particles)) THEN
00378       CALL cp_subsys_set(fist_env%subsys,&
00379                         local_particles=local_particles,&
00380                         error=error)
00381     END IF
00382     IF (PRESENT(local_molecules)) THEN
00383       CALL cp_subsys_set(fist_env%subsys,&
00384                         local_molecules_new=local_molecules,&
00385                         error=error)
00386     END IF
00387     IF (PRESENT(molecule_kind_set)) THEN
00388       CALL mol_kind_new_list_create(molecule_kinds_new,&
00389                                     els_ptr=molecule_kind_set,&
00390                                     error=error)
00391       CALL cp_subsys_set(fist_env%subsys,&
00392                         molecule_kinds_new=molecule_kinds_new,&
00393                         error=error)
00394       CALL mol_kind_new_list_release(molecule_kinds_new,error=error)
00395     END IF
00396     IF (PRESENT(molecule_set)) THEN
00397       CALL mol_new_list_create(molecules_new,&
00398                                els_ptr=molecule_set,&
00399                                error=error)
00400       CALL cp_subsys_set(fist_env%subsys,&
00401                         molecules_new=molecules_new,&
00402                         error=error)
00403       CALL mol_new_list_release(molecules_new,error=error)
00404     END IF
00405     IF (PRESENT(exclusions)) fist_env%exclusions=>exclusions
00406     IF (PRESENT(shell_model)) THEN
00407        fist_env%shell_model = shell_model
00408     END IF
00409     IF (PRESENT(shell_model_ad)) THEN
00410        fist_env%shell_model_ad = shell_model_ad
00411     END IF
00412 
00413   END SUBROUTINE fist_env_set
00414 
00415 ! *****************************************************************************
00425   SUBROUTINE fist_env_create(fist_env,para_env,error)
00426     TYPE(fist_environment_type), POINTER     :: fist_env
00427     TYPE(cp_para_env_type), POINTER          :: para_env
00428     TYPE(cp_error_type), INTENT(inout)       :: error
00429 
00430     CHARACTER(len=*), PARAMETER :: routineN = 'fist_env_create', 
00431       routineP = moduleN//':'//routineN
00432 
00433     INTEGER                                  :: stat
00434     LOGICAL                                  :: failure
00435 
00436     failure=.FALSE.
00437 
00438     ALLOCATE(fist_env, stat=stat)
00439     CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
00440     IF (.NOT. failure) THEN
00441        CALL init_fist_env(fist_env,para_env=para_env, error=error)
00442     END IF
00443   END SUBROUTINE fist_env_create
00444 
00445 ! *****************************************************************************
00454   SUBROUTINE fist_env_retain(fist_env,error)
00455     TYPE(fist_environment_type), POINTER     :: fist_env
00456     TYPE(cp_error_type), INTENT(inout)       :: error
00457 
00458     CHARACTER(len=*), PARAMETER :: routineN = 'fist_env_retain', 
00459       routineP = moduleN//':'//routineN
00460 
00461     LOGICAL                                  :: failure
00462 
00463     failure=.FALSE.
00464     CPPrecondition(ASSOCIATED(fist_env),cp_failure_level,routineP,error,failure)
00465     IF (.NOT. failure) THEN
00466        CPPrecondition(fist_env%ref_count>0,cp_failure_level,routineP,error,failure)
00467        fist_env%ref_count=fist_env%ref_count+1
00468     END IF
00469   END SUBROUTINE fist_env_retain
00470 
00471 ! *****************************************************************************
00480   SUBROUTINE fist_env_release(fist_env,error)
00481     TYPE(fist_environment_type), POINTER     :: fist_env
00482     TYPE(cp_error_type), INTENT(inout)       :: error
00483 
00484     CHARACTER(len=*), PARAMETER :: routineN = 'fist_env_release', 
00485       routineP = moduleN//':'//routineN
00486 
00487     INTEGER                                  :: stat
00488     LOGICAL                                  :: failure
00489 
00490     failure=.FALSE.
00491 
00492     IF (ASSOCIATED(fist_env)) THEN
00493        CPPrecondition(fist_env%ref_count>0,cp_failure_level,routineP,error,failure)
00494        fist_env%ref_count=fist_env%ref_count-1
00495        IF (fist_env%ref_count<1) THEN
00496           CALL qmmm_env_mm_release(fist_env%qmmm_env, error=error)
00497           CALL cell_release(fist_env%cell,error=error)
00498           CALL cell_release(fist_env%cell_ref,error=error)
00499           CALL ewald_pw_release(fist_env%ewald_pw,error=error)
00500           CALL ewald_env_release(fist_env%ewald_env,error=error)
00501           CALL cp_para_env_release(fist_env%para_env,error=error)
00502           CALL deallocate_fist_energy(fist_env%thermo)
00503 
00504           CALL fist_nonbond_env_release ( fist_env % fist_nonbond_env, error = error )
00505           CALL cp_result_release(fist_env%results,error=error)
00506           CALL cp_subsys_release(fist_env%subsys,error=error)
00507           CALL section_vals_release(fist_env%input,error=error)
00508           CALL exclusion_release(fist_env%exclusions,error=error)
00509 
00510           DEALLOCATE(fist_env, stat=stat)
00511           CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error)
00512        END IF
00513     END IF
00514     NULLIFY(fist_env)
00515   END SUBROUTINE fist_env_release
00516 
00517 END MODULE fist_environment_types