|
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 ! ***************************************************************************** 00013 MODULE cp_para_env 00014 USE cp_para_types, ONLY: cp_para_cart_type,& 00015 cp_para_env_type 00016 USE f77_blas 00017 USE message_passing, ONLY: mp_comm_dup,& 00018 mp_comm_free,& 00019 mp_environ 00020 #include "cp_common_uses.h" 00021 00022 IMPLICIT NONE 00023 PRIVATE 00024 00025 LOGICAL, PRIVATE, PARAMETER :: debug_this_module=.TRUE. 00026 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_para_env' 00027 00028 PUBLIC :: cp_para_env_retain, cp_para_env_release, cp_para_env_create, & 00029 cp_para_env_duplicate,& 00030 cp_para_env_write 00031 PUBLIC :: cp_cart_create, cp_cart_release, cp_cart_update, cp_cart_retain,& 00032 cp_cart_write 00033 !*** 00034 CONTAINS 00035 00036 ! ***************************************************************************** 00050 SUBROUTINE cp_para_env_create(para_env, group, source,mepos, num_pe,& 00051 owns_group,error) 00052 TYPE(cp_para_env_type), POINTER :: para_env 00053 INTEGER, INTENT(in) :: group 00054 INTEGER, INTENT(in), OPTIONAL :: source, mepos, num_pe 00055 LOGICAL, INTENT(in), OPTIONAL :: owns_group 00056 TYPE(cp_error_type), INTENT(inout) :: error 00057 00058 CHARACTER(len=*), PARAMETER :: routineN = 'cp_para_env_create', 00059 routineP = moduleN//':'//routineN 00060 00061 INTEGER :: stat 00062 LOGICAL :: failure 00063 00064 failure=.FALSE. 00065 00066 CPPrecondition(.NOT.ASSOCIATED(para_env),cp_failure_level,routineP,error,failure) 00067 ALLOCATE(para_env,stat=stat) 00068 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00069 IF (.NOT.failure) THEN 00070 para_env%group=group 00071 para_env%source=0 00072 para_env%ref_count=1 00073 para_env%owns_group=.TRUE. 00074 IF (PRESENT(source)) para_env%source=source 00075 IF (PRESENT(owns_group)) para_env%owns_group=owns_group 00076 IF (.NOT.(PRESENT(mepos).AND.PRESENT(num_pe))) THEN 00077 CALL cp_para_env_update(para_env,error=error) 00078 ELSE 00079 para_env%mepos=mepos 00080 para_env%num_pe=num_pe 00081 END IF 00082 para_env%ionode=para_env%mepos==para_env%source 00083 END IF 00084 END SUBROUTINE cp_para_env_create 00085 00086 ! ***************************************************************************** 00098 SUBROUTINE cp_para_env_duplicate(para_env, TEMPLATE, source,error) 00099 TYPE(cp_para_env_type), POINTER :: para_env, TEMPLATE 00100 INTEGER, INTENT(in), OPTIONAL :: source 00101 TYPE(cp_error_type), INTENT(inout) :: error 00102 00103 CHARACTER(len=*), PARAMETER :: routineN = 'cp_para_env_duplicate', 00104 routineP = moduleN//':'//routineN 00105 00106 INTEGER :: stat 00107 LOGICAL :: failure 00108 00109 failure=.FALSE. 00110 00111 CPPrecondition(ASSOCIATED(TEMPLATE),cp_failure_level,routineP,error,failure) 00112 IF (.NOT.failure) THEN 00113 CPPrecondition(template%ref_count>0,cp_failure_level,routineP,error,failure) 00114 END IF 00115 IF (.NOT.failure) THEN 00116 ALLOCATE(para_env,stat=stat) 00117 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00118 END IF 00119 IF (.NOT.failure) THEN 00120 para_env%ref_count=1 00121 CALL mp_comm_dup(template%group,para_env%group) 00122 para_env%source=template%source 00123 para_env%owns_group=.TRUE. 00124 IF (PRESENT(source)) para_env%source=source 00125 CALL cp_para_env_update(para_env,error=error) 00126 para_env%ionode=para_env%mepos==para_env%source 00127 END IF 00128 END SUBROUTINE cp_para_env_duplicate 00129 00130 ! ***************************************************************************** 00140 SUBROUTINE cp_para_env_retain(para_env, error) 00141 TYPE(cp_para_env_type), POINTER :: para_env 00142 TYPE(cp_error_type), INTENT(inout) :: error 00143 00144 CHARACTER(len=*), PARAMETER :: routineN = 'cp_para_env_retain', 00145 routineP = moduleN//':'//routineN 00146 00147 LOGICAL :: failure 00148 00149 failure=.FALSE. 00150 00151 CPPrecondition(ASSOCIATED(para_env),cp_failure_level,routineP,error,failure) 00152 IF (.NOT.failure) THEN 00153 CPPrecondition(para_env%ref_count>0,cp_failure_level,routineP,error,failure) 00154 para_env%ref_count=para_env%ref_count+1 00155 END IF 00156 END SUBROUTINE cp_para_env_retain 00157 00158 ! ***************************************************************************** 00171 SUBROUTINE cp_para_env_release(para_env, error) 00172 TYPE(cp_para_env_type), POINTER :: para_env 00173 TYPE(cp_error_type), INTENT(inout) :: error 00174 00175 CHARACTER(len=*), PARAMETER :: routineN = 'cp_para_env_release', 00176 routineP = moduleN//':'//routineN 00177 00178 INTEGER :: stat 00179 LOGICAL :: failure 00180 00181 failure=.FALSE. 00182 00183 IF (ASSOCIATED(para_env)) THEN 00184 CPPrecondition(para_env%ref_count>0,cp_failure_level,routineP,error,failure) 00185 para_env%ref_count=para_env%ref_count-1 00186 IF (para_env%ref_count<1) THEN 00187 IF (para_env%owns_group) THEN 00188 CALL mp_comm_free(para_env%group) 00189 END IF 00190 DEALLOCATE(para_env,stat=stat) 00191 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00192 END IF 00193 END IF 00194 NULLIFY(para_env) 00195 END SUBROUTINE cp_para_env_release 00196 00197 ! ***************************************************************************** 00206 SUBROUTINE cp_para_env_update(para_env, error) 00207 TYPE(cp_para_env_type), POINTER :: para_env 00208 TYPE(cp_error_type), INTENT(inout) :: error 00209 00210 CHARACTER(len=*), PARAMETER :: routineN = 'cp_para_env_update', 00211 routineP = moduleN//':'//routineN 00212 00213 LOGICAL :: failure 00214 00215 failure=.FALSE. 00216 00217 CPPrecondition(ASSOCIATED(para_env),cp_failure_level,routineP,error,failure) 00218 IF (.NOT.failure) THEN 00219 CPPrecondition(para_env%ref_count>0,cp_failure_level,routineP,error,failure) 00220 END IF 00221 IF (.NOT.failure) THEN 00222 CALL mp_environ(taskid=para_env%mepos,numtask=para_env%num_pe,& 00223 groupid=para_env%group) 00224 para_env%ionode=para_env%mepos==para_env%source 00225 END IF 00226 END SUBROUTINE cp_para_env_update 00227 00228 ! ***************************************************************************** 00238 SUBROUTINE cp_para_env_write(para_env,unit_nr,error) 00239 TYPE(cp_para_env_type), POINTER :: para_env 00240 INTEGER, INTENT(in) :: unit_nr 00241 TYPE(cp_error_type), INTENT(inout) :: error 00242 00243 CHARACTER(len=*), PARAMETER :: routineN = 'cp_para_env_write', 00244 routineP = moduleN//':'//routineN 00245 00246 INTEGER :: iostat 00247 LOGICAL :: failure 00248 00249 failure=.FALSE. 00250 00251 IF (ASSOCIATED(para_env)) THEN 00252 WRITE (unit=unit_nr,& 00253 fmt="(' <cp_para_env>:{ owns_group=',l1,',')",& 00254 iostat=iostat) para_env%owns_group 00255 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00256 WRITE (unit=unit_nr,fmt="(' group=',i10,', ref_count=',i10,',')",& 00257 iostat=iostat) para_env%group, para_env%ref_count 00258 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00259 WRITE (unit=unit_nr,fmt="(' mepos=',i8,',')",& 00260 iostat=iostat) para_env%mepos 00261 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00262 WRITE (unit=unit_nr,fmt="(' source=',i8,',')",& 00263 iostat=iostat) para_env%source 00264 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00265 WRITE (unit=unit_nr,fmt="(' num_pe=',i8,'}')",& 00266 iostat=iostat) para_env%num_pe 00267 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00268 ELSE 00269 WRITE (unit=unit_nr,& 00270 fmt="(a)", iostat=iostat) ' <cp_para_env>:*null* ' 00271 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00272 END IF 00273 END SUBROUTINE cp_para_env_write 00274 00275 ! ***************************************************************************** 00286 SUBROUTINE cp_cart_create(cart, group, ndims,owns_group, error) 00287 TYPE(cp_para_cart_type), POINTER :: cart 00288 INTEGER, INTENT(in) :: group, ndims 00289 LOGICAL, INTENT(in), OPTIONAL :: owns_group 00290 TYPE(cp_error_type), INTENT(inout) :: error 00291 00292 CHARACTER(len=*), PARAMETER :: routineN = 'cp_cart_create', 00293 routineP = moduleN//':'//routineN 00294 00295 INTEGER :: stat 00296 LOGICAL :: failure 00297 00298 failure=.FALSE. 00299 00300 CPPrecondition(.NOT.ASSOCIATED(cart),cp_failure_level,routineP,error,failure) 00301 ALLOCATE(cart,stat=stat) 00302 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00303 IF (.NOT.failure) THEN 00304 cart%owns_group=.TRUE. 00305 IF (PRESENT(owns_group)) cart%owns_group=owns_group 00306 cart%ndims=ndims 00307 cart%group=group 00308 00309 ALLOCATE(cart%source(ndims),cart%periodic(ndims),cart%mepos(ndims),& 00310 cart%num_pe(ndims),stat=stat) 00311 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00312 00313 cart%source=0 00314 cart%mepos=0 00315 cart%periodic=.FALSE. 00316 cart%ref_count=1 00317 cart%ntask=1 00318 CALL cp_cart_update(cart,error=error) 00319 END IF 00320 END SUBROUTINE cp_cart_create 00321 00322 ! ***************************************************************************** 00329 SUBROUTINE cp_cart_update(cart,error) 00330 TYPE(cp_para_cart_type), POINTER :: cart 00331 TYPE(cp_error_type), INTENT(inout) :: error 00332 00333 CHARACTER(len=*), PARAMETER :: routineN = 'cp_cart_update', 00334 routineP = moduleN//':'//routineN 00335 00336 LOGICAL :: failure 00337 00338 failure=.FALSE. 00339 00340 CPPrecondition(ASSOCIATED(cart),cp_failure_level,routineP,error,failure) 00341 CPPrecondition(cart%ref_count>0,cp_failure_level,routineP,error,failure) 00342 IF (.NOT. failure) THEN 00343 CALL mp_environ( cart%group, cart%ndims, cart%num_pe, task_coor=cart%mepos, & 00344 periods=cart%periodic) 00345 CALL mp_environ( numtask=cart%ntask, taskid=cart%rank, groupid=cart%group) 00346 END IF 00347 END SUBROUTINE cp_cart_update 00348 00349 ! ***************************************************************************** 00356 SUBROUTINE cp_cart_release(cart,error) 00357 TYPE(cp_para_cart_type), POINTER :: cart 00358 TYPE(cp_error_type), INTENT(inout) :: error 00359 00360 CHARACTER(len=*), PARAMETER :: routineN = 'cp_cart_release', 00361 routineP = moduleN//':'//routineN 00362 00363 INTEGER :: stat 00364 LOGICAL :: failure 00365 00366 failure=.FALSE. 00367 00368 IF (ASSOCIATED(cart)) THEN 00369 CPPrecondition(cart%ref_count>0,cp_failure_level,routineP,error,failure) 00370 cart%ref_count=cart%ref_count-1 00371 IF (cart%ref_count==0) THEN 00372 IF (cart%owns_group) THEN 00373 CALL mp_comm_free(cart%group) 00374 END IF 00375 DEALLOCATE(cart%source,cart%periodic,cart%mepos,cart%num_pe,stat=stat) 00376 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00377 DEALLOCATE(cart,stat=stat) 00378 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00379 END IF 00380 END IF 00381 NULLIFY(cart) 00382 END SUBROUTINE cp_cart_release 00383 00384 ! ***************************************************************************** 00391 SUBROUTINE cp_cart_retain(cart,error) 00392 TYPE(cp_para_cart_type), POINTER :: cart 00393 TYPE(cp_error_type), INTENT(inout) :: error 00394 00395 CHARACTER(len=*), PARAMETER :: routineN = 'cp_cart_retain', 00396 routineP = moduleN//':'//routineN 00397 00398 LOGICAL :: failure 00399 00400 failure=.FALSE. 00401 00402 CPPrecondition(ASSOCIATED(cart),cp_failure_level,routineP,error,failure) 00403 IF (.NOT. failure) THEN 00404 CPPrecondition(cart%ref_count>0,cp_failure_level,routineP,error,failure) 00405 cart%ref_count=cart%ref_count+1 00406 END IF 00407 END SUBROUTINE cp_cart_retain 00408 00409 ! ***************************************************************************** 00417 SUBROUTINE cp_cart_write(cart,unit_nr,error) 00418 TYPE(cp_para_cart_type), POINTER :: cart 00419 INTEGER, INTENT(in) :: unit_nr 00420 TYPE(cp_error_type), INTENT(inout) :: error 00421 00422 CHARACTER(len=*), PARAMETER :: routineN = 'cp_cart_write', 00423 routineP = moduleN//':'//routineN 00424 00425 INTEGER :: iostat 00426 LOGICAL :: failure 00427 00428 failure=.FALSE. 00429 00430 IF (ASSOCIATED(cart)) THEN 00431 WRITE (unit=unit_nr,& 00432 fmt="(' <cp_cart>:{ owns_group=',l1,',')",& 00433 iostat=iostat) cart%owns_group 00434 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00435 WRITE (unit=unit_nr,fmt="(' group=',i10,', ref_count=',i10,',')",& 00436 iostat=iostat) cart%group, cart%ref_count 00437 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00438 WRITE (unit=unit_nr,fmt="(' ndims=',i8,',')",& 00439 iostat=iostat) cart%ndims 00440 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00441 WRITE (unit=unit_nr,fmt="(' rank=',i8,', ntask=',i8,',')",& 00442 iostat=iostat) cart%rank, cart%ntask 00443 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00444 WRITE (unit=unit_nr,fmt="(' mepos=',10i8)",& 00445 iostat=iostat) cart%mepos 00446 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00447 WRITE (unit=unit_nr,fmt="(' source=',10i8,',')",& 00448 iostat=iostat) cart%source 00449 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00450 WRITE (unit=unit_nr,fmt="(' num_pe=',10i8,'}')",& 00451 iostat=iostat) cart%num_pe 00452 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00453 WRITE (unit=unit_nr,fmt="(' periodic=',10l2,'}')",& 00454 iostat=iostat) cart%periodic 00455 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00456 ELSE 00457 WRITE (unit=unit_nr,& 00458 fmt="(a)", iostat=iostat) ' <cp_cart>:*null* ' 00459 CPInvariant(iostat==0,cp_failure_level,routineP,error,failure) 00460 END IF 00461 END SUBROUTINE cp_cart_write 00462 00463 END MODULE cp_para_env
1.7.3