|
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 ! ***************************************************************************** 00035 MODULE mol_kind_new_list_types 00036 USE f77_blas 00037 USE molecule_kind_types, ONLY: deallocate_molecule_kind_set,& 00038 molecule_kind_type 00039 #include "cp_common_uses.h" 00040 00041 IMPLICIT NONE 00042 PRIVATE 00043 00044 LOGICAL, PRIVATE, PARAMETER :: debug_this_module=.TRUE. 00045 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mol_kind_new_list_types' 00046 INTEGER, PRIVATE, SAVE :: last_mol_kind_new_list_id=0 00047 00048 PUBLIC :: mol_kind_new_list_type, mol_kind_new_list_p_type 00049 PUBLIC :: mol_kind_new_list_create, mol_kind_new_list_retain,& 00050 mol_kind_new_list_release 00051 00052 !*** 00053 00054 ! ***************************************************************************** 00067 TYPE mol_kind_new_list_type 00068 INTEGER :: id_nr, ref_count, n_els 00069 LOGICAL :: owns_els 00070 TYPE(molecule_kind_type), DIMENSION(:), POINTER :: els 00071 END TYPE mol_kind_new_list_type 00072 00073 ! ***************************************************************************** 00080 TYPE mol_kind_new_list_p_type 00081 TYPE(mol_kind_new_list_type), POINTER :: list 00082 END TYPE mol_kind_new_list_p_type 00083 00084 CONTAINS 00085 00086 ! ***************************************************************************** 00101 SUBROUTINE mol_kind_new_list_create(list, els_ptr, & 00102 owns_els, n_els, error) 00103 TYPE(mol_kind_new_list_type), OPTIONAL, 00104 POINTER :: list 00105 TYPE(molecule_kind_type), DIMENSION(:), 00106 OPTIONAL, POINTER :: els_ptr 00107 LOGICAL, INTENT(in), OPTIONAL :: owns_els 00108 INTEGER, INTENT(in), OPTIONAL :: n_els 00109 TYPE(cp_error_type), INTENT(inout) :: error 00110 00111 CHARACTER(len=*), PARAMETER :: routineN = 'mol_kind_new_list_create', 00112 routineP = moduleN//':'//routineN 00113 00114 INTEGER :: stat 00115 LOGICAL :: failure 00116 00117 failure=.FALSE. 00118 00119 CPPrecondition(PRESENT(els_ptr).OR.PRESENT(n_els),cp_failure_level,routineP,error,failure) 00120 00121 IF (.NOT. failure) THEN 00122 ALLOCATE(list, stat=stat) 00123 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00124 END IF 00125 IF (.NOT. failure) THEN 00126 last_mol_kind_new_list_id=last_mol_kind_new_list_id+1 00127 list%id_nr=last_mol_kind_new_list_id 00128 list%ref_count=1 00129 list%owns_els=.TRUE. 00130 list%n_els=0 00131 IF (PRESENT(owns_els)) list%owns_els=owns_els 00132 NULLIFY(list%els) 00133 IF (PRESENT(els_ptr)) THEN 00134 list%els => els_ptr 00135 IF (ASSOCIATED(els_ptr)) THEN 00136 list%n_els=SIZE(els_ptr) 00137 END IF 00138 END IF 00139 IF (PRESENT(n_els)) list%n_els=n_els 00140 IF (.NOT.ASSOCIATED(list%els)) THEN 00141 ALLOCATE(list%els(list%n_els),stat=stat) 00142 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00143 CPPreconditionNoFail(list%owns_els,cp_warning_level,routineP,error) 00144 END IF 00145 END IF 00146 END SUBROUTINE mol_kind_new_list_create 00147 00148 ! ***************************************************************************** 00157 SUBROUTINE mol_kind_new_list_retain(list, error) 00158 TYPE(mol_kind_new_list_type), POINTER :: list 00159 TYPE(cp_error_type), INTENT(inout) :: error 00160 00161 CHARACTER(len=*), PARAMETER :: routineN = 'mol_kind_new_list_retain', 00162 routineP = moduleN//':'//routineN 00163 00164 LOGICAL :: failure 00165 00166 failure=.FALSE. 00167 00168 CPPrecondition(ASSOCIATED(list),cp_failure_level,routineP,error,failure) 00169 IF (.NOT. failure) THEN 00170 CPPrecondition(list%ref_count>0,cp_failure_level,routineP,error,failure) 00171 list%ref_count=list%ref_count+1 00172 END IF 00173 END SUBROUTINE mol_kind_new_list_retain 00174 00175 ! ***************************************************************************** 00184 SUBROUTINE mol_kind_new_list_release(list, error) 00185 TYPE(mol_kind_new_list_type), POINTER :: list 00186 TYPE(cp_error_type), INTENT(inout) :: error 00187 00188 CHARACTER(len=*), PARAMETER :: routineN = 'mol_kind_new_list_release', 00189 routineP = moduleN//':'//routineN 00190 00191 INTEGER :: stat 00192 LOGICAL :: failure 00193 00194 failure=.FALSE. 00195 00196 IF (ASSOCIATED(list)) THEN 00197 CPPrecondition(list%ref_count>0,cp_failure_level,routineP,error,failure) 00198 list%ref_count=list%ref_count-1 00199 IF (list%ref_count==0) THEN 00200 IF (list%owns_els) THEN 00201 IF (ASSOCIATED(list%els)) THEN 00202 CALL deallocate_molecule_kind_set(list%els,error=error) 00203 END IF 00204 END IF 00205 NULLIFY(list%els) 00206 DEALLOCATE(list,stat=stat) 00207 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00208 END IF 00209 END IF 00210 NULLIFY(list) 00211 END SUBROUTINE mol_kind_new_list_release 00212 00213 ! template def put here so that line numbers in template and derived 00214 ! files are almost the same (multi-line use change it a bit) 00215 ! [template(el_typename,el_type,USE,deallocate_els_code)] 00216 ! ARGS: 00217 ! USE = "use molecule_kind_types, only: molecule_kind_type, deallocate_molecule_kind_set" 00218 ! deallocate_els_code = "call deallocate_molecule_kind_set(list%els,error=error)" 00219 ! el_type = "type(molecule_kind_type)" 00220 ! el_typename = "mol_kind_new" 00221 00222 00223 END MODULE mol_kind_new_list_types
1.7.3