CP2K 2.4 (Revision 12889)

cp2k_runs.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 ! *****************************************************************************
00007 MODULE cp2k_runs
00008 
00009   USE atom,                            ONLY: atom_code
00010   USE bsse,                            ONLY: do_bsse_calculation
00011   USE cell_opt,                        ONLY: cp_cell_opt
00012   USE cp2k_debug,                      ONLY: cp2k_debug_energy_and_forces
00013   USE cp2k_info,                       ONLY: compile_date,&
00014                                              compile_revision,&
00015                                              cp2k_version,&
00016                                              cp2k_year,&
00017                                              enable_color_tags
00018   USE cp_dbcsr_interface,              ONLY: cp_dbcsr_config,&
00019                                              cp_dbcsr_finalize_lib,&
00020                                              cp_dbcsr_init_lib,&
00021                                              cp_dbcsr_print_config
00022   USE cp_files,                        ONLY: close_file,&
00023                                              open_file
00024   USE cp_output_handling,              ONLY: cp_add_iter_level,&
00025                                              cp_print_key_finished_output,&
00026                                              cp_print_key_unit_nr,&
00027                                              cp_rm_iter_level
00028   USE cp_para_env,                     ONLY: cp_para_env_create,&
00029                                              cp_para_env_release,&
00030                                              cp_para_env_retain
00031   USE cp_para_types,                   ONLY: cp_para_env_type
00032   USE cp_parser_methods,               ONLY: parser_search_string
00033   USE cp_parser_types,                 ONLY: cp_parser_type,&
00034                                              parser_create,&
00035                                              parser_release
00036   USE cp_units,                        ONLY: cp_unit_set_create,&
00037                                              cp_unit_set_release,&
00038                                              cp_unit_set_type,&
00039                                              print_all_units
00040   USE cuda_memory,                     ONLY: cuda_device_mem_init,&
00041                                              cuda_device_mem_release
00042   USE environment,                     ONLY: cp2k_finalize,&
00043                                              cp2k_init,&
00044                                              cp2k_read,&
00045                                              cp2k_setup
00046   USE f77_blas
00047   USE f77_interface,                   ONLY: create_force_env,&
00048                                              destroy_force_env,&
00049                                              f77_default_para_env => default_para_env,&
00050                                              f_env_add_defaults,&
00051                                              f_env_rm_defaults,&
00052                                              f_env_type
00053   USE farming_methods,                 ONLY: do_deadlock,&
00054                                              do_nothing,&
00055                                              do_wait,&
00056                                              farming_parse_input,&
00057                                              get_next_job
00058   USE farming_types,                   ONLY: deallocate_farming_env,&
00059                                              farming_env_type,&
00060                                              init_farming_env,&
00061                                              job_finished,&
00062                                              job_running
00063   USE force_env_methods,               ONLY: force_env_calc_energy_force
00064   USE force_env_types,                 ONLY: force_env_get,&
00065                                              force_env_type
00066   USE geo_opt,                         ONLY: cp_geo_opt
00067   USE global_types,                    ONLY: global_environment_type,&
00068                                              globenv_create,&
00069                                              globenv_release,&
00070                                              globenv_retain
00071   USE input_constants,                 ONLY: &
00072        bsse_run, cell_opt_run, debug_run, do_atom, do_band, do_cp2k, do_ep, &
00073        do_farming, do_fist, do_mixed, do_opt_basis, do_optimize_input, &
00074        do_qmmm, do_qs, do_tamc, do_test, ehrenfest, electronic_spectra_run, &
00075        energy_force_run, energy_run, geo_opt_run, linear_response_run, &
00076        mol_dyn_run, mon_car_run, none_run, pint_run, real_time_propagation, &
00077        vib_anal
00078   USE input_cp2k,                      ONLY: create_cp2k_input_reading,&
00079                                              create_cp2k_root_section,&
00080                                              create_global_section,&
00081                                              empty_initial_variables
00082   USE input_cp2k_check,                ONLY: check_cp2k_input
00083   USE input_keyword_types,             ONLY: keyword_release
00084   USE input_parsing,                   ONLY: section_vals_parse
00085   USE input_section_types,             ONLY: &
00086        section_describe_html, section_describe_index_html, section_release, &
00087        section_type, section_typo_match, section_vals_create, &
00088        section_vals_get_subs_vals, section_vals_release, section_vals_retain, &
00089        section_vals_type, section_vals_val_get, section_vals_write, &
00090        write_section_xml
00091   USE kinds,                           ONLY: default_path_length,&
00092                                              default_string_length,&
00093                                              dp
00094   USE library_tests,                   ONLY: lib_test
00095   USE machine,                         ONLY: m_chdir,&
00096                                              m_flush,&
00097                                              m_getcwd,&
00098                                              m_walltime
00099   USE mc_run,                          ONLY: do_mon_car
00100   USE md_run,                          ONLY: qs_mol_dyn
00101   USE message_passing,                 ONLY: &
00102        mp_any_source, mp_bcast, mp_comm_dup, mp_comm_free, mp_comm_split, &
00103        mp_environ, mp_recv, mp_send, mp_sum, mp_sync
00104   USE neb_methods,                     ONLY: neb
00105   USE optimize_basis,                  ONLY: run_optimize_basis
00106   USE optimize_input,                  ONLY: run_optimize_input
00107   USE pint_methods,                    ONLY: do_pint_run
00108   USE qs_linres_module,                ONLY: linres_calculation
00109   USE qs_tddfpt_module,                ONLY: tddfpt_calculation
00110   USE reference_manager,               ONLY: print_all_references,&
00111                                              print_format_html
00112   USE rt_propagation,                  ONLY: rt_prop_setup
00113   USE string_utilities,                ONLY: html_entity_table
00114   USE tamc_run,                        ONLY: qs_tamc
00115   USE timings,                         ONLY: timeset,&
00116                                              timestop
00117   USE vibrational_analysis,            ONLY: vb_anal
00118 #include "cp_common_uses.h"
00119 
00120   IMPLICIT NONE
00121 
00122   PRIVATE
00123   PUBLIC  :: cp2k_run, write_cp2k_html_manual, write_xml_file, run_input, &
00124              farming_run
00125   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp2k_runs'
00126 CONTAINS
00127 
00128 ! *****************************************************************************
00151   RECURSIVE FUNCTION cp2k_run(input_file_name,output_unit,mpi_comm) RESULT(cp2k_run_OK)
00152 
00153     CHARACTER(LEN=*), INTENT(IN)             :: input_file_name
00154     INTEGER, INTENT(IN)                      :: output_unit, mpi_comm
00155     LOGICAL                                  :: cp2k_run_OK
00156 
00157     CHARACTER(LEN=*), PARAMETER :: routineN = 'cp2k_run', 
00158       routineP = moduleN//':'//routineN
00159 
00160     CHARACTER(LEN=512)                       :: matching_string(15), 
00161                                                 unknown_string
00162     INTEGER :: f_env_handle, i, ierr, iter_level, matching_rank(15), 
00163       method_name_id, new_env_id, prog_name_id, run_type_id, unit_nr
00164     LOGICAL                                  :: echo_input, failure, 
00165                                                 I_was_ionode, was_present
00166     TYPE(cp_error_type)                      :: error, suberror
00167     TYPE(cp_logger_type), POINTER            :: logger, sublogger
00168     TYPE(cp_para_env_type), POINTER          :: para_env
00169     TYPE(f_env_type), POINTER                :: f_env
00170     TYPE(force_env_type), POINTER            :: force_env
00171     TYPE(global_environment_type), POINTER   :: globenv
00172     TYPE(section_type), POINTER              :: input_structure
00173     TYPE(section_vals_type), POINTER         :: glob_section, input_file, 
00174                                                 root_section
00175 
00176     cp2k_run_OK = .FALSE.
00177     failure=.FALSE.
00178     was_present = .FALSE.
00179     NULLIFY(para_env, f_env)
00180     CALL cp_para_env_create(para_env, group=mpi_comm,&
00181          owns_group=.FALSE.,error=error)
00182 
00183     CALL cp_dbcsr_init_lib (group=mpi_comm, error=error)
00184 
00185     NULLIFY(globenv, force_env)
00186 
00187     CALL cp_error_init(error, stop_level=cp_fatal_level)
00188 
00189     ! parse the input
00190     input_file => create_cp2k_input_reading(input_file_name,initial_variables=empty_initial_variables, &
00191                                             para_env=para_env,error=error)
00192 
00193     ! put failure to true if this is what happened on parsing the input
00194     CALL cp_error_check(error,failure)
00195     IF (failure) THEN
00196        logger => cp_error_get_logger(error)
00197        unit_nr=cp_logger_get_default_io_unit(logger)
00198        IF (unit_nr>0) THEN
00199           CALL cp_error_get(error,info=unknown_string)
00200           WRITE(unit_nr,'(T2,A)') ""
00201           WRITE(unit_nr,'(T2,A)') "Looking for words in the input similar to the unknown: "
00202           WRITE(unit_nr,'(T4,A)') ''''//TRIM(unknown_string)//''''
00203           WRITE(unit_nr,'(T2,A)') ""
00204           CALL m_flush(unit_nr)
00205           matching_rank=0
00206           matching_string=""
00207           NULLIFY(input_structure)
00208           CALL cp_error_init(suberror,template_error=error)
00209           CALL create_cp2k_root_section(input_structure,error=suberror)
00210           CALL cp_error_dealloc_ref(suberror)
00211           CALL section_typo_match(input_structure,unknown_string,location_string="", &
00212                                   matching_rank=matching_rank,matching_string=matching_string,error=error)
00213           CALL section_release(input_structure,error=error)
00214           DO I=1,SIZE(matching_rank,1)
00215              IF (matching_rank(i)>0) THEN
00216                  WRITE(unit_nr,'(T2,A)') TRIM(matching_string(I))
00217              ENDIF
00218           ENDDO
00219           WRITE(unit_nr,'(T15,A)') ""
00220           WRITE(unit_nr,'(T15,A)') "CP2K failed to parse the input file."
00221           WRITE(unit_nr,'(T15,A)') "A full description of the input for this CP2K version"
00222           WRITE(unit_nr,'(T15,A)') "can be generated using:"
00223           WRITE(unit_nr,'(T15,A)') ""
00224           WRITE(unit_nr,'(T15,A)') "cp2k.sopt --html-manual"
00225           WRITE(unit_nr,'(T15,A)') ""
00226           WRITE(unit_nr,'(T15,A)') "The manual for the latest version of CP2K is online available:"
00227           WRITE(unit_nr,'(T15,A)') ""
00228           WRITE(unit_nr,'(T15,A)') "http://manual.cp2k.org/trunk"
00229           WRITE(unit_nr,'(T15,A)') ""
00230           WRITE(unit_nr,'(T15,A)') "If this input was an input of a previous version"
00231           WRITE(unit_nr,'(T15,A)') "of CP2K, you can try to convert it with --permissive-echo."
00232           WRITE(unit_nr,'(T15,A)') "However, this will just ignore the unknown keywords ..."
00233           WRITE(unit_nr,'(T15,A)') ""
00234           CALL m_flush(unit_nr)
00235        ENDIF
00236        CALL mp_sync(para_env%group)
00237     ELSE
00238        glob_section => section_vals_get_subs_vals(input_file,"GLOBAL",error=error)
00239        CALL section_vals_val_get(glob_section,"ECHO_INPUT",l_val=echo_input,&
00240             error=error)
00241        logger => cp_error_get_logger(error)
00242        IF (echo_input) THEN
00243           CALL section_vals_write(input_file,&
00244                unit_nr=cp_logger_get_default_io_unit(logger),&
00245                hide_root=.TRUE., hide_defaults=.FALSE., error=error)
00246        END IF
00247 
00248        IF (.NOT.failure) THEN
00249           CALL check_cp2k_input(input_file,para_env=para_env,output_unit=output_unit,error=error)
00250        END IF
00251        CALL cp_error_check(error,failure)
00252 
00253        IF (failure) THEN
00254           logger => cp_error_get_logger(error)
00255           unit_nr=cp_logger_get_default_io_unit(logger)
00256           IF (unit_nr>0) THEN
00257              WRITE(unit_nr,'(T15,A)') ""
00258              WRITE(unit_nr,'(T15,A)') "CP2K failed to parse the input."
00259              WRITE(unit_nr,'(T15,A)') "It was presumably generated by an incompatible CP2K version."
00260              WRITE(unit_nr,'(T15,A)') "try --permissive-echo to generate a compatible input file (to be checked!!!)"
00261              WRITE(unit_nr,'(T15,A)') ""
00262              CALL m_flush(unit_nr)
00263           ENDIF
00264        ELSE
00265           root_section=>input_file
00266           CALL section_vals_val_get(input_file,"GLOBAL%PROGRAM_NAME",&
00267                i_val=prog_name_id,error=error)
00268           CALL section_vals_val_get(input_file,"GLOBAL%RUN_TYPE",&
00269                i_val=run_type_id,error=error)
00270 
00271           IF (prog_name_id/=do_cp2k) THEN
00272              ! initial setup (cp2k does in in the creation of the force_env)
00273              CALL globenv_create(globenv, error=error)
00274              ! XXXXXXXXX
00275              ! root_section => input_file
00276              ! XXXXXXXXX
00277              CALL section_vals_retain(input_file,error=error)
00278              CALL cp2k_init(para_env, output_unit, globenv, input_file_name=input_file_name)
00279              CALL cp_error_init(suberror)
00280              CALL cp2k_read(root_section,para_env,globenv,error=error)
00281              CALL cp2k_setup(root_section,para_env, globenv,suberror)
00282           END IF
00283 
00284 ! if CUDA is enabled we need to allocate memory on the graphics card
00285           CALL cuda_device_mem_init(root_section, error)
00286 
00287           CALL cp_dbcsr_config (root_section, error)
00288           IF (output_unit > 0 .AND.&
00289                cp_logger_would_log(logger, cp_note_level)) THEN
00290              CALL cp_dbcsr_print_config (unit_nr=output_unit, error=error)
00291              WRITE (UNIT=output_unit,FMT='()')
00292           ENDIF
00293 
00294 
00295 
00296 
00297           SELECT CASE (prog_name_id)
00298           CASE (do_atom)
00299              globenv%run_type_id = none_run
00300              CALL atom_code(root_section,suberror)
00301           CASE (do_optimize_input)
00302              CALL run_optimize_input(root_section, para_env, suberror)
00303           CASE (do_farming)
00304              CALL farming_run ( root_section, para_env, suberror )
00305           CASE (do_opt_basis)
00306              CALL run_optimize_basis ( root_section, para_env, suberror )
00307              globenv%run_type_id = none_run
00308           CASE(do_cp2k)
00309              CALL create_force_env(new_env_id,input_path=input_file_name,&
00310                   output_path="__STD_OUT__",mpi_comm=para_env%group,&
00311                   output_unit=output_unit,&
00312                   owns_out_unit=.FALSE.,&
00313                   input=input_file,ierr=ierr)
00314              CPAssert(ierr==0,cp_failure_level,routineP,error,failure)
00315              CALL f_env_add_defaults(new_env_id,f_env,new_error=suberror,&
00316                   failure=failure,handle=f_env_handle)
00317              force_env => f_env%force_env
00318              CALL force_env_get(force_env,globenv=globenv,error=suberror)
00319              CALL globenv_retain(globenv,error=suberror)
00320              CALL section_vals_val_get(force_env%force_env_section,"METHOD",i_val=method_name_id,error=error)
00321 
00322           CASE (do_test)
00323              CALL lib_test(root_section,para_env,globenv,suberror)
00324           CASE default
00325              CPAssert(.FALSE.,cp_failure_level,routineP,suberror,failure)
00326           END SELECT
00327           CALL section_vals_release(input_file,error=suberror)
00328           SELECT CASE (globenv%run_type_id)
00329           CASE (pint_run)
00330              CALL do_pint_run( para_env, root_section, globenv, error=suberror )
00331           CASE (none_run)
00332              ! do nothing
00333           CASE (energy_run, energy_force_run)
00334              IF(  method_name_id /= do_qs .AND.&
00335                   method_name_id /= do_qmmm .AND.&
00336                   method_name_id /= do_ep .AND.&
00337                   method_name_id /= do_mixed .AND.&
00338                   method_name_id /= do_fist )  &
00339                   CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,routineP,&
00340                   "Energy/Force run not available for all methods "//&
00341                   CPSourceFileRef,&
00342                   suberror,failure)
00343 
00344              sublogger => cp_error_get_logger(error)
00345              CALL cp_add_iter_level(sublogger%iter_info,"JUST_ENERGY",&
00346                   n_rlevel_new=iter_level,&
00347                   error=suberror)
00348              SELECT CASE(globenv%run_type_id)
00349              CASE (energy_run)
00350                 CALL force_env_calc_energy_force(force_env,calc_force=.FALSE.,error=suberror)
00351              CASE(energy_force_run)
00352                 CALL force_env_calc_energy_force(force_env,calc_force=.TRUE. ,error=suberror)
00353              CASE default
00354                 CPAssert(.FALSE.,cp_failure_level,routineP,error,failure)
00355              END SELECT
00356              CALL cp_rm_iter_level(sublogger%iter_info,level_name="JUST_ENERGY",n_rlevel_att=iter_level,&
00357                   error=suberror)
00358           CASE (mol_dyn_run)
00359              CALL qs_mol_dyn ( force_env, globenv, error=suberror )
00360           CASE (geo_opt_run)
00361              CALL cp_geo_opt(force_env,globenv,error=suberror)
00362           CASE (cell_opt_run)
00363              CALL cp_cell_opt(force_env,globenv,error=suberror)
00364           CASE (mon_car_run)
00365              CALL do_mon_car ( force_env, globenv, input_file_name, error=suberror )
00366           CASE (do_tamc)
00367              CALL qs_tamc ( force_env, globenv, input_file_name, error=suberror )
00368           CASE (electronic_spectra_run)
00369              IF(method_name_id /= do_qs) &
00370                   CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,routineP,&
00371                   "Electron spectra available only with Quickstep. "//&
00372                   CPSourceFileRef,&
00373                   suberror,failure)
00374              CALL force_env_calc_energy_force(force_env,calc_force=.FALSE.,&
00375                   error=suberror)
00376              CALL tddfpt_calculation(force_env%qs_env, error=error)
00377           CASE (real_time_propagation)
00378              IF(method_name_id /= do_qs) &
00379                   CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,routineP,&
00380                   "Real time propagation needs METHOD QS. "//&
00381                   CPSourceFileRef,&
00382                   suberror,failure)
00383              force_env%qs_env%dft_control%rtp_control%fixed_ions=.TRUE.
00384              CALL rt_prop_setup(force_env,error)
00385           CASE (ehrenfest)
00386              IF(method_name_id /= do_qs) &
00387                   CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,routineP,&
00388                   "Ehrenfest dynamics needs METHOD QS "//&
00389                   CPSourceFileRef,&
00390                   suberror,failure)
00391              force_env%qs_env%dft_control%rtp_control%fixed_ions=.FALSE.
00392              CALL qs_mol_dyn ( force_env, globenv, error=suberror )
00393           CASE (bsse_run)
00394              CALL do_bsse_calculation(force_env, globenv, error=suberror)
00395           CASE (linear_response_run)
00396              IF(method_name_id /= do_qs .AND. &
00397                 method_name_id /= do_qmmm) &
00398                 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,routineP,&
00399                      "Property calculations by Linear Response only within the QS or QMMM program "//&
00400                      CPSourceFileRef,&
00401                      suberror,failure)
00402              ! The Ground State is needed, it can be read from Restart
00403              CALL force_env_calc_energy_force(force_env,calc_force=.FALSE.,&
00404                                               error=suberror)
00405              CALL linres_calculation(force_env, error=suberror)
00406           CASE (debug_run)
00407              SELECT CASE(method_name_id)
00408              CASE(do_qs, do_qmmm, do_ep, do_fist)
00409                 CALL cp2k_debug_energy_and_forces(force_env, error=suberror)
00410              CASE DEFAULT
00411                 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,routineP,&
00412                      "Debug run available only with QS, FIST, and QMMM program "//&
00413                      CPSourceFileRef,&
00414                      suberror,failure)
00415              END SELECT
00416           CASE (vib_anal)
00417              CALL vb_anal(root_section,para_env,globenv,error=suberror)
00418           CASE (do_band)
00419              CALL neb(root_section,para_env,globenv,error=suberror)
00420           CASE default
00421              CPAssert(.FALSE.,cp_failure_level,routineP,error,failure)
00422           END SELECT
00423 
00424           CALL cp_error_propagate_error(suberror,routineP,&
00425                "cp2k ending run", error=error,failure=failure)
00426           IF (prog_name_id==do_cp2k) THEN
00427              f_env%force_env => force_env ! for mc
00428              CALL globenv_retain(globenv,error=error)!mc
00429              CALL globenv_release(force_env%globenv,error=error) !mc
00430              force_env%globenv => globenv !mc
00431              CALL f_env_rm_defaults(f_env,error=suberror,ierr=ierr,&
00432                   handle=f_env_handle)
00433              CPAssert(ierr==0,cp_failure_level,routineP,error,failure)
00434              CALL destroy_force_env(new_env_id,ierr=ierr)
00435              CPAssert(ierr==0,cp_failure_level,routineP,error,failure)
00436              CALL globenv_release(globenv,error=error)
00437           ELSE
00438              CALL cp_error_dealloc_ref(suberror)
00439              I_was_ionode=para_env%ionode
00440              CALL cp2k_finalize(root_section,para_env,globenv,error=error)
00441              CPPostconditionNoFail(globenv%ref_count==1,cp_failure_level,routineP,error)
00442              CALL section_vals_release(root_section,error=error)
00443              CALL globenv_release(globenv,error=error)
00444           END IF
00445        END IF
00446 
00447     END IF
00448 
00449 ! if CUDA is enabled we need to free memory on the graphics card
00450     CALL cuda_device_mem_release()
00451 
00452     CALL cp_dbcsr_finalize_lib (error=error)
00453 
00454     CALL cp_error_dealloc_ref(error)
00455     CALL cp_para_env_release(para_env,error=error)
00456     cp2k_run_OK = .NOT. failure
00457 
00458   END FUNCTION cp2k_run
00459 
00460 ! *****************************************************************************
00467   RECURSIVE SUBROUTINE farming_run(root_section,para_env, error)
00468     TYPE(section_vals_type), POINTER         :: root_section
00469     TYPE(cp_para_env_type), POINTER          :: para_env
00470     TYPE(cp_error_type), INTENT(INOUT)       :: error
00471 
00472     CHARACTER(len=*), PARAMETER :: routineN = 'farming_run', 
00473       routineP = moduleN//':'//routineN
00474     INTEGER, PARAMETER                       :: slave_status_done = -3, 
00475                                                 slave_status_wait = -4
00476 
00477     CHARACTER(len=7)                         :: label
00478     CHARACTER(LEN=default_path_length)       :: output_file
00479     CHARACTER(LEN=default_string_length)     :: str
00480     INTEGER :: dest, handle, i, i_job_to_restart, ierr, ijob, ijob_current, 
00481       ijob_end, ijob_start, iunit, n_jobs_to_run, new_group, new_output_unit, 
00482       new_rank, new_size, ngroups, num_slaves, output_unit, primus_slave, 
00483       slave_group, slave_rank, source, stat, tag, todo
00484     INTEGER, DIMENSION(:), POINTER           :: group_distribution, 
00485                                                 master_slave_partition, 
00486                                                 slave_distribution, 
00487                                                 slave_status
00488     LOGICAL                                  :: failure, found, master, 
00489                                                 run_OK, slave
00490     REAL(KIND=dp)                            :: t1, t2
00491     REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: waittime
00492     TYPE(cp_logger_type), POINTER            :: logger
00493     TYPE(cp_parser_type), POINTER            :: my_parser
00494     TYPE(cp_unit_set_type), POINTER          :: default_units
00495     TYPE(farming_env_type), POINTER          :: farming_env
00496     TYPE(section_type), POINTER              :: g_section
00497     TYPE(section_vals_type), POINTER         :: g_data
00498 
00499 
00500     failure=.FALSE.
00501     ! the primus of all slaves, talks to the master on topics concerning all slaves
00502     CALL timeset(routineN,handle)
00503     NULLIFY(my_parser,g_section,g_data,default_units)
00504 
00505     logger => cp_error_get_logger(error)
00506     output_unit=cp_print_key_unit_nr(logger,root_section,"FARMING%PROGRAM_RUN_INFO",&
00507                                          extension=".log",error=error)
00508 
00509     IF (output_unit>0) WRITE(output_unit,FMT="(T2,A)") "FARMING| Hi, welcome on this farm!"
00510 
00511     ALLOCATE(farming_env,STAT=stat)
00512     CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
00513     CALL init_farming_env(farming_env)
00514     ! remember where we started
00515     CALL m_getcwd(farming_env%cwd)
00516     CALL farming_parse_input(farming_env,root_section,para_env,error)
00517 
00518     ! the full mpi group is first split in a slave group and a master group, the latter being at most 1 process
00519     slave=.TRUE.
00520     master=.FALSE.
00521     IF (farming_env%master_slave) THEN
00522        IF (output_unit>0) WRITE(output_unit,FMT="(T2,A)") "FARMING| using a master-slave setup"
00523 
00524        ALLOCATE(master_slave_partition(0:1))
00525        master_slave_partition=(/1,para_env%num_pe-1/)
00526        ALLOCATE(group_distribution(0:para_env%num_pe-1),STAT=stat)
00527        CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
00528 
00529        CALL mp_comm_split(para_env%group,slave_group,ngroups,group_distribution,&
00530                    n_subgroups=2, group_partition=master_slave_partition)
00531        DEALLOCATE(master_slave_partition)
00532        DEALLOCATE(group_distribution)
00533        CALL mp_environ(num_slaves,slave_rank,slave_group)
00534 
00535        IF (para_env%mepos==0) THEN
00536            slave =.FALSE.
00537            master=.TRUE.
00538            ! on the master node, num_slaves corresponds to the size of the master group
00539            ! due to the mp_environ call.
00540            CPPostcondition(num_slaves==1,cp_failure_level,routineP,error,failure)
00541            num_slaves=para_env%num_pe-1
00542            slave_rank=-1
00543        ENDIF
00544        CPPostcondition(num_slaves==para_env%num_pe-1,cp_failure_level,routineP,error,failure)
00545     ELSE
00546        ! all processes are slaves
00547        IF (output_unit>0) WRITE(output_unit,FMT="(T2,A)") "FARMING| using a slave-only setup"
00548        CALL mp_comm_dup(para_env%group,slave_group)
00549        CALL mp_environ(num_slaves,slave_rank,slave_group)
00550     ENDIF
00551     IF (output_unit>0) WRITE(output_unit,FMT="(T2,A,I0)") "FARMING| number of slaves ",num_slaves
00552 
00553     ! keep track of which para_env rank is which slave/master
00554     ALLOCATE(slave_distribution(0:para_env%num_pe-1),STAT=stat)
00555     CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
00556     slave_distribution=0
00557     slave_distribution(para_env%mepos)=slave_rank
00558     CALL mp_sum(slave_distribution,para_env%group)
00559     ! we do have a primus inter pares
00560     primus_slave=0
00561     DO i=1,para_env%num_pe-1
00562        IF (slave_distribution(i)==0) primus_slave=i
00563     ENDDO
00564 
00565     ! split the current communicator for the slaves
00566     ! in a new_group, new_size and new_rank according to the number of groups required according to the input
00567     ALLOCATE(group_distribution(0:num_slaves-1),STAT=stat)
00568     CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
00569     group_distribution=-1
00570     IF (slave) THEN
00571         IF (farming_env%group_size_wish_set) THEN
00572            farming_env%group_size_wish=MIN(farming_env%group_size_wish,para_env%num_pe)
00573            CALL mp_comm_split(slave_group,new_group,ngroups,group_distribution,&
00574                    subgroup_min_size=farming_env%group_size_wish)
00575         ELSE IF (farming_env%ngroup_wish_set) THEN
00576            CALL mp_comm_split(slave_group,new_group,ngroups,group_distribution,&
00577                    n_subgroups=farming_env%ngroup_wish,&
00578                    group_partition=farming_env%group_partition)
00579         ELSE
00580            CPPostcondition(.FALSE.,cp_failure_level,routineP,error,failure)
00581         ENDIF
00582         CALL mp_environ(new_size,new_rank,new_group)
00583     ENDIF
00584 
00585     ! transfer the info about the slave group distribution to the master
00586     IF (farming_env%master_slave) THEN
00587        IF (para_env%mepos==primus_slave) THEN
00588            tag=1
00589            CALL mp_send(group_distribution,0,tag,para_env%group)
00590            tag=2
00591            CALL mp_send(ngroups,0,tag,para_env%group)
00592        ENDIF
00593        IF (para_env%mepos==0) THEN
00594            tag=1
00595            CALL mp_recv(group_distribution,primus_slave,tag,para_env%group)
00596            tag=2
00597            CALL mp_recv(ngroups,primus_slave,tag,para_env%group)
00598        ENDIF
00599     ENDIF
00600 
00601     ! write info on group distribution
00602     IF (output_unit>0) THEN
00603         WRITE(output_unit,FMT="(T2,A,T71,I10)") "FARMING| Number of created MPI (slave) groups:",ngroups
00604         WRITE(output_unit,FMT="(T2,A)",ADVANCE="NO") "FARMING| MPI (slave) process to group correspondence:"
00605         DO i=0,num_slaves-1
00606            IF (MODULO(i,4)==0) WRITE(output_unit,*)
00607            WRITE(output_unit,FMT='(A3,I6,A3,I6,A1)',ADVANCE="NO")&
00608                 "  (",i," : ",group_distribution(i),")"
00609         END DO
00610         WRITE(output_unit,*)
00611     ENDIF
00612 
00613     ! protect about too many jobs being run in single go. Not more jobs are allowed than the number in the input file
00614     ! and determine the future restart point
00615     IF (farming_env%cycle) THEN
00616        n_jobs_to_run=farming_env%max_steps*ngroups
00617        i_job_to_restart=MODULO(farming_env%restart_n+n_jobs_to_run-1,farming_env%njobs)+1
00618     ELSE
00619        n_jobs_to_run=MIN(farming_env%njobs,farming_env%max_steps*ngroups)
00620        n_jobs_to_run=MIN(n_jobs_to_run,farming_env%njobs-farming_env%restart_n+1)
00621        i_job_to_restart=n_jobs_to_run+farming_env%restart_n
00622     ENDIF
00623 
00624     ! and write the restart now, that's the point where the next job starts, even if this one is running
00625     iunit=cp_print_key_unit_nr(logger,root_section,"FARMING%RESTART",&
00626          extension=".restart",error=error)
00627     IF (iunit>0) THEN
00628        WRITE(iunit,*) i_job_to_restart
00629     ENDIF
00630     CALL cp_print_key_finished_output(iunit,logger,root_section,"FARMING%RESTART",error=error)
00631 
00632 
00633     ! this is the job range to be executed.
00634     ijob_start=farming_env%restart_n
00635     ijob_end=ijob_start+n_jobs_to_run-1
00636     IF (output_unit>0 .AND. ijob_end-ijob_start<0) THEN
00637        WRITE(output_unit,FMT="(T2,A)") "FARMING| --- WARNING --- NO JOBS NEED EXECUTION ? "
00638        WRITE(output_unit,FMT="(T2,A)") "FARMING| is the cycle keyword required ?"
00639        WRITE(output_unit,FMT="(T2,A)") "FARMING| or is a stray RESTART file present ?"
00640        WRITE(output_unit,FMT="(T2,A)") "FARMING| or is the group_size requested smaller than the number of CPUs?"
00641     ENDIF
00642 
00643     ! actual executions of the jobs in two different modes
00644     IF (farming_env%master_slave) THEN
00645        IF (slave) THEN
00646           ! keep on doing work until master has decided otherwise
00647           todo=do_wait
00648           DO
00649              IF (new_rank==0) THEN
00650                 ! the head slave tells the master he's done or ready to start
00651                 ! the message tells what has been done lately
00652                 tag=1
00653                 dest=0
00654                 CALL mp_send(todo,dest,tag,para_env%group)
00655 
00656                 ! gets the new todo item
00657                 tag=2
00658                 source=0
00659                 CALL mp_recv(todo,source,tag,para_env%group)
00660 
00661                 ! and informs his peer slaves
00662                 CALL mp_bcast(todo,0,new_group)
00663              ELSE
00664                 CALL mp_bcast(todo,0,new_group)
00665              ENDIF
00666 
00667              ! if the todo is do_nothing we are flagged to quit. Otherwise it is the job number
00668              SELECT CASE(todo)
00669              CASE(do_wait,do_deadlock)
00670                 ! go for a next round, but we first wait a bit
00671                 t1=m_walltime()
00672                 DO
00673                   t2=m_walltime()
00674                   IF (t2-t1>farming_env%wait_time) EXIT
00675                 ENDDO
00676              CASE(do_nothing)
00677                 EXIT
00678              CASE(1:)
00679                 CALL execute_job(todo)
00680              END SELECT
00681           ENDDO
00682        ELSE ! master
00683           ALLOCATE(slave_status(0:ngroups-1),STAT=stat)
00684           CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
00685           slave_status=slave_status_wait
00686           ijob_current=ijob_start-1
00687 
00688           DO
00689              IF (ALL(slave_status==slave_status_done)) EXIT
00690 
00691              ! who's the next slave waiting for work
00692              tag=1
00693              source=mp_any_source
00694              CALL mp_recv(todo,source,tag,para_env%group) ! updates source
00695              IF (todo>0) THEN
00696                 farming_env%Job(todo)%status=job_finished
00697                 IF (output_unit>0) THEN
00698                    WRITE(output_unit,FMT=*) "Job finished: ",todo
00699                    CALL m_flush(output_unit)
00700                 ENDIF
00701              ENDIF
00702 
00703              ! get the next job in line, this could be do_nothing, if we're finished
00704              CALL get_next_job(farming_env,ijob_start,ijob_end,ijob_current,todo)
00705              dest=source
00706              tag =2
00707              CALL mp_send(todo,dest,tag,para_env%group)
00708 
00709              IF (todo>0) THEN
00710                farming_env%Job(todo)%status=job_running
00711                IF (output_unit>0) THEN
00712                  WRITE(output_unit,FMT=*) "Job: ",todo," Dir: ",TRIM(farming_env%Job(todo)%cwd), &
00713                                         " assigned to group ",group_distribution(slave_distribution(dest))
00714                  CALL m_flush(output_unit)
00715                ENDIF
00716              ELSE
00717                IF (todo==do_nothing) THEN
00718                    slave_status(group_distribution(slave_distribution(dest)))=slave_status_done
00719                    IF (output_unit>0) THEN
00720                       WRITE(output_unit,FMT=*) "group done: ",group_distribution(slave_distribution(dest))
00721                       CALL m_flush(output_unit)
00722                    ENDIF
00723                ENDIF
00724                IF (todo==do_deadlock) THEN
00725                    IF (output_unit>0) THEN
00726                       WRITE(output_unit,FMT=*) ""
00727                       WRITE(output_unit,FMT=*) "FARMING JOB DEADLOCKED ... CIRCULAR DEPENDENCIES"
00728                       WRITE(output_unit,FMT=*) ""
00729                       CALL m_flush(output_unit)
00730                    ENDIF
00731                    CPPostcondition(todo.NE.do_deadlock,cp_failure_level,routineP,error,failure)
00732                ENDIF
00733              ENDIF
00734 
00735           ENDDO
00736 
00737           DEALLOCATE(slave_status,STAT=stat)
00738           CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
00739 
00740        ENDIF
00741     ELSE
00742        ! this is the non-master-slave mode way of executing the jobs
00743        ! the i-th job in the input is always executed by the MODULO(i-1,ngroups)-th group
00744        ! (needed for cyclic runs, we don't want two groups working on the same job)
00745        IF (output_unit>0) THEN
00746          IF (ijob_end-ijob_start>=0) THEN
00747            WRITE(output_unit,FMT="(T2,A)") "FARMING| List of jobs : "
00748            DO ijob=ijob_start,ijob_end
00749             i=MODULO(ijob-1,farming_env%njobs)+1
00750             WRITE(output_unit,FMT=*) "Job: ",i," Dir: ",TRIM(farming_env%Job(i)%cwd)," Input: ", &
00751               TRIM(farming_env%Job(i)%input)," MPI group:", MODULO(i-1,ngroups)
00752            ENDDO
00753          ENDIF
00754        ENDIF
00755 
00756        DO ijob=ijob_start,ijob_end
00757           i=MODULO(ijob-1,farming_env%njobs)+1
00758           ! this farms out the jobs
00759           IF (MODULO(i-1,ngroups)==group_distribution(slave_rank)) THEN
00760              IF (output_unit > 0) WRITE(output_unit,FMT="(T2,A,I5.5,A)",ADVANCE="NO") " Running Job ",i, &
00761                            " in "//TRIM(farming_env%Job(i)%cwd)//"."
00762              CALL execute_job(i)
00763              IF (output_unit > 0) THEN
00764                 WRITE(output_unit,FMT="(A)") " Done, output in "//TRIM(output_file)
00765                 CALL m_flush(output_unit)
00766              ENDIF
00767           ENDIF
00768        ENDDO
00769     ENDIF
00770 
00771     ! keep information about how long each process has to wait
00772     ! i.e. the load imbalance
00773     t1=m_walltime()
00774     CALL mp_sync(para_env%group)
00775     t2=m_walltime()
00776     ALLOCATE(waittime(0:para_env%num_pe-1))
00777     waittime=0.0_dp
00778     waittime(para_env%mepos)=t2-t1
00779     CALL mp_sum(waittime,para_env%group)
00780     IF (output_unit>0) THEN
00781        WRITE(output_unit,'(T2,A)') "Process idle times [s] at the end of the run"
00782        DO i=0,para_env%num_pe-1
00783          WRITE(output_unit,FMT='(A2,I6,A3,F8.3,A1)',ADVANCE="NO")&
00784                 " (",i," : ",waittime(i),")"
00785          IF (MOD(i+1,4)==0) WRITE(output_unit,'(A)') ""
00786        ENDDO
00787        CALL m_flush(output_unit)
00788     ENDIF
00789     DEALLOCATE(waittime)
00790 
00791     ! give back the communicators of the split groups
00792     IF (slave) CALL mp_comm_free(new_group)
00793     CALL mp_comm_free(slave_group)
00794 
00795     ! and message passing deallocate structures
00796     DEALLOCATE(group_distribution,STAT=stat)
00797     CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
00798     DEALLOCATE(slave_distribution,STAT=stat)
00799     CPPostcondition(stat==0,cp_failure_level,routineP,error,failure)
00800 
00801     ! clean the farming env
00802     CALL deallocate_farming_env(farming_env)
00803 
00804     CALL cp_print_key_finished_output(output_unit,logger,root_section,&
00805                "FARMING%PROGRAM_RUN_INFO", error=error)
00806 
00807     CALL timestop(handle)
00808 
00809   CONTAINS
00810 ! *****************************************************************************
00811     SUBROUTINE execute_job(i)
00812     INTEGER                                  :: i
00813 
00814 ! change to the new working directory
00815 
00816        CALL m_chdir(TRIM(farming_env%Job(i)%cwd),ierr)
00817        CPPostcondition(ierr==0,cp_failure_level,routineP,error,failure)
00818 
00819        ! generate a fresh call to cp2k_run
00820        IF (new_rank == 0) THEN
00821 
00822           IF (farming_env%Job(i)%output=="") THEN
00823              ! generate the output file
00824              WRITE(output_file,'(A12,I5.5)') "FARMING_OUT_",i
00825              CALL parser_create(my_parser,file_name=TRIM(farming_env%Job(i)%input),error=error)
00826              label="&GLOBAL"
00827              CALL parser_search_string(my_parser,label,ignore_case=.TRUE.,found=found,error=error)
00828              IF (found) THEN
00829                 CALL create_global_section(g_section,error=error)
00830                 CALL section_vals_create(g_data,g_section,error=error)
00831                 CALL cp_unit_set_create(default_units, "OUTPUT",error=error)
00832                 CALL section_vals_parse(g_data,my_parser,default_units,&
00833                      error=error)
00834                 CALL cp_unit_set_release(default_units,error=error)
00835                 CALL section_vals_val_get(g_data,"PROJECT",&
00836                      c_val=str, error=error)
00837                 IF (str.NE."") output_file=TRIM(str)//".out"
00838                 CALL section_vals_val_get(g_data,"OUTPUT_FILE_NAME",&
00839                         c_val=str,error=error)
00840                 IF (str.NE."") output_file=str
00841                 CALL section_vals_release(g_data,error=error)
00842                 CALL section_release(g_section,error=error)
00843              END IF
00844              CALL parser_release(my_parser,error=error)
00845           ELSE
00846              output_file=farming_env%Job(i)%output
00847           ENDIF
00848 
00849           CALL open_file(file_name=TRIM(output_file),&
00850                  file_action="WRITE",&
00851                  file_status="UNKNOWN",&
00852                  file_position="APPEND",&
00853                  unit_number=new_output_unit)
00854        ELSE
00855          ! this unit should be negative, otherwise all processors that get a default unit
00856          ! start writing output (to the same file, adding to confusion).
00857          ! error handling should be careful, asking for a local output unit if required
00858          new_output_unit=-1
00859        ENDIF
00860 
00861        run_OK=cp2k_run(TRIM(farming_env%Job(i)%input),new_output_unit,new_group)
00862 
00863        IF (new_rank == 0) CALL close_file(unit_number=new_output_unit)
00864 
00865        ! change to the original working directory
00866        CALL m_chdir(TRIM(farming_env%cwd),ierr)
00867        CPPostcondition(ierr==0,cp_failure_level,routineP,error,failure)
00868 
00869      END SUBROUTINE execute_job
00870   END SUBROUTINE farming_run
00871 
00872 ! *****************************************************************************
00878   SUBROUTINE write_cp2k_html_manual(error)
00879     TYPE(cp_error_type), INTENT(inout)       :: error
00880 
00881     CHARACTER(len=*), PARAMETER :: routineN = 'write_cp2k_html_manual', 
00882       routineP = moduleN//':'//routineN
00883 
00884     INTEGER                                  :: unit_nr
00885     LOGICAL                                  :: failure
00886     TYPE(section_type), POINTER              :: root_section
00887 
00888     failure=.FALSE.
00889 
00890     IF (.NOT. failure) THEN
00891        NULLIFY(root_section)
00892        CALL create_cp2k_root_section(root_section,error=error)
00893        ! remove the default keyword that ignores things outside the section
00894        CALL keyword_release(root_section%keywords(0)%keyword,error=error)
00895 
00896        CALL section_describe_html(root_section,"InputReference",0,6,error=error)
00897 
00898        CALL open_file(unit_number=unit_nr,file_name="index.html",&
00899             file_action="WRITE", file_status="REPLACE")
00900        WRITE(unit_nr,FMT='(A)') "<HTML><BODY><HEAD><TITLE>The cp2k input structure</TITLE>"
00901        WRITE(unit_nr,FMT='(A)') "<H1>CP2K input reference</H1>"
00902        WRITE(unit_nr,FMT='(A)') "<H2>Version information</H2>"
00903        WRITE(unit_nr,FMT='(A)') &
00904             "This html manual can be generated automatically from a given cp2k executable "// &
00905             "using the --html-manual command line option. The manual describes exactly that version of the code. "//&
00906             "This version has been generated using a cp2k version compiled on "//TRIM(compile_date)//". "//&
00907             "The SVN source code revision number is "//TRIM(compile_revision)//"."
00908 
00909        WRITE(unit_nr,FMT='(A)') '<H2>Search the online input reference manual</H2>'
00910        WRITE(unit_nr,FMT='(A)') '<TABLE><TR><TD>'
00911        ! Yahoo seems to actually search our pages
00912        WRITE(unit_nr,FMT='(A)') ' <!-- START CODE --> '
00913        WRITE(unit_nr,FMT='(A)') '         <div id="ysrchForm" style="border:1px solid #7E9DB9;'
00914        WRITE(unit_nr,FMT='(A)') '                                background:#FFFFFF;'
00915        WRITE(unit_nr,FMT='(A)') '                                width:300px;'
00916        WRITE(unit_nr,FMT='(A)') '                                margin:0 auto;'
00917        WRITE(unit_nr,FMT='(A)') '                                padding:20px; '
00918        WRITE(unit_nr,FMT='(A)') '                                position:relative;'
00919        WRITE(unit_nr,FMT='(A)') '                              ">'
00920        WRITE(unit_nr,FMT='(A)') &
00921             '           <form id="searchBoxForm_undefined" action="http://search.yahoo.com/search" style="padding:0;">'
00922        WRITE(unit_nr,FMT='(A)') '                         '
00923        WRITE(unit_nr,FMT='(A)') '                         <input name="ei" value="UTF-8" type="hidden">'
00924        WRITE(unit_nr,FMT='(A)') &
00925             '                         <input name="fr" value="ystg" type="hidden"><div style="padding:0 80px 0 0;zoom:1;">'
00926        WRITE(unit_nr,FMT='(A)') '                                         <input type="text" id="searchTerm"'
00927        WRITE(unit_nr,FMT='(A)') '                                                 onFocus="this.style.background=''#fff'';"'
00928        WRITE(unit_nr,FMT='(A)') &
00929             '                                                 onBlur="if(this.value=='''')this.style.background='//&
00930             '''#fff url(http://us.i1.yimg.com/us.yimg.com/i/us/sch/gr/horiz_pwrlogo_red2.gif) 3px center  no-repeat''"'
00931        WRITE(unit_nr,FMT='(A)') &
00932             ' name="p" style=" margin:1px 0; width:100%; border:1px solid #7E9DB9; color:#666666; height:18px; '//&
00933             'padding:0px 3px; background:#fff url(http://us.i1.yimg.com/us.yimg.com/i/us/sch/gr/horiz_pwrlogo_red2.gif)'//&
00934             ' 3px center no-repeat; position:relative;">'
00935        WRITE(unit_nr,FMT='(A)') ' <input type="submit" id="btn_undefined" value="Search" '
00936        WRITE(unit_nr,FMT='(A)') &
00937             ' style=" padding-bottom:2px; position:absolute; right:20px; top:20px; margin:0px; height:22px; width:65px; ">'
00938        WRITE(unit_nr,FMT='(A)') ' </div><ul style="color:#666666;'
00939        WRITE(unit_nr,FMT='(A)') '            font:11px/11px normal Arial, Helvetica, sans-serif;'
00940        WRITE(unit_nr,FMT='(A)') '            margin:0;'
00941        WRITE(unit_nr,FMT='(A)') '            padding:0;'
00942        WRITE(unit_nr,FMT='(A)') '            text-align:left;'
00943        WRITE(unit_nr,FMT='(A)') '            list-style-type:none;radios"><li style="display:inline;padding-right:10px;">'
00944        WRITE(unit_nr,FMT='(A)') &
00945             ' <input name="vs" id="web_radio" value=""    type="radio" style="vertical-align:middle;margin-right:5px; ">'
00946        WRITE(unit_nr,FMT='(A)') ' <label for="web_radio" style="vertical-align:middle;">Web</label>'
00947        WRITE(unit_nr,FMT='(A)') ' </li><li style="display:inline;padding-right:10px;">'
00948        WRITE(unit_nr,FMT='(A)') &
00949             ' <input name="vs" id="site_radio" value="www.cp2k.org"   checked="checked" type="radio"'//&
00950             ' style="vertical-align:middle;margin-right:5px; ">'
00951        WRITE(unit_nr,FMT='(A)') ' <label for="site_radio" style="vertical-align:middle;">this Site</label>'
00952        WRITE(unit_nr,FMT='(A)') ' </li></ul></form></div>'
00953        WRITE(unit_nr,FMT='(A)') ' <!-- END CODE --></TD><TD> '
00954 
00955        WRITE(unit_nr,FMT='(A)') '</TD></TR></TABLE>'
00956 
00957        WRITE(unit_nr,FMT='(A)') '<H2>Journal papers</H2>'
00958        WRITE(unit_nr,FMT='(A)') '<A HREF="references.html">List of references</A> cited in the CP2K input manual.'
00959 
00960        WRITE(unit_nr,FMT='(A)') '<H2>Units of Measurement</H2>'
00961        WRITE(unit_nr,FMT='(A)') '<A HREF="units.html">List of unites</A> organized into groups based on the physical quantity '//&
00962             "they measure. The units can be used to specify an alternative unit of measurement for keyword values, for which a "//&
00963             "default unit has been explicitly defined."
00964 
00965        IF (enable_color_tags) THEN
00966           WRITE(unit_nr,FMT='(A)') "<H2>Color convention</H2>"
00967           WRITE(unit_nr,FMT='(A)') &
00968                "Sections and Keywords supported in the current released version of cp2k are marked "//&
00969                "with green color. Keywords or Sections specifically designed for the development version or still "//&
00970                "in a development status (not ready for the released version) are marked with black/blue color."
00971        END IF
00972 
00973        WRITE(unit_nr,FMT='(A)') "<H2>Internal Input Preprocessor</H2>"
00974        WRITE(unit_nr,FMT='(A)') "Before the input is parsed, the input is run through a very simple internal preprocessor."
00975        WRITE(unit_nr,FMT='(A)') "The preprocessor recognizes the following directives independent of capitalization:<BR><DL>"
00976        WRITE(unit_nr,FMT='(A)') "<DT><B>@INCLUDE 'filename.inc'</B></DT>"
00977        WRITE(unit_nr,FMT='(A)') "<DD>The file referenced by <I>filename.inc</I> is included into the input file and parsed."
00978        WRITE(unit_nr,FMT='(A)') "Recursive inclusions are not allowed and the files have to exist in the current working "
00979        WRITE(unit_nr,FMT='(A)') "directory. There can be only one @INCLUDE statement per line. Single or double quotes "
00980        WRITE(unit_nr,FMT='(A)') "can be used and <B>have</B> to be used if the filename contains blanks.</DD>"
00981        WRITE(unit_nr,FMT='(A)') "<DT><B>@SET VAR value</B></DT>"
00982        WRITE(unit_nr,FMT='(A)') "<DD>Assigns the text <I>value</I> to the preprocessing variable <I>VAR</I>. <I>value</I> "
00983        WRITE(unit_nr,FMT='(A)') "is the text following <I>VAR</I> with the outer whitespace removed. The variable can be "
00984        WRITE(unit_nr,FMT='(A)') "recalled with a <I>${VAR}</I> statement. There can be only one @SET statement per line.</DD>"
00985        WRITE(unit_nr,FMT='(A)') "<DT><B>${VAR}</B></DT>"
00986        WRITE(unit_nr,FMT='(A)') "<DD>Expand the variable <I>VAR</I>. The text <I>${VAR}</I> is replaced with the value assigned "
00987        WRITE(unit_nr,FMT='(A)') "to <I>VAR</I> in the last corresponding @SET directive. There can be multiple variables per line. "
00988        WRITE(unit_nr,FMT='(A)') "The expansion process is repeated until no more variables are found.</DD>"
00989        WRITE(unit_nr,FMT='(A)') "<DT><B>@IF / @ENDIF</B></DT>"
00990        WRITE(unit_nr,FMT='(A)') "<DD>Conditional block. The text from the @IF line up to the next line with a valid "
00991        WRITE(unit_nr,FMT='(A)') "@ENDIF is skipped, if the expression following @IF resolves to <I>false</I>. "
00992        WRITE(unit_nr,FMT='(A)') "Available expressions are lexical comparisons for equality '==' or inequality '/='."
00993        WRITE(unit_nr,FMT='(A)') "If none of the two operators are found, a '0' or whitespace resolves to <I>false</I> "
00994        WRITE(unit_nr,FMT='(A)') "while any text resolves to <I>true</I>. @IF/@ENDIF blocks cannot be nested and "
00995        WRITE(unit_nr,FMT='(A)') "cannot span across files. There can be only one test (== or /=) per @IF statement.</DD>"
00996        WRITE(unit_nr,FMT='(A)') "</DL><P>"
00997 
00998        WRITE(unit_nr,FMT='(A)') "<H2>Input structure</H2>"
00999        WRITE(unit_nr,FMT='(A)') "All sections that can be part of a cp2k input file are shown with their allowed nestings. "
01000        WRITE(unit_nr,FMT='(A)') "A description of each section, and a list of keywords can be obtained clicking on the links. "
01001        WRITE(unit_nr,FMT='(A)') "<BR><UL>"
01002 
01003        CALL section_describe_index_html(root_section,"InputReference",unit_nr,error=error)
01004 
01005        WRITE(unit_nr,FMT='(A)') '</UL><BR><hr>Back to the <A HREF="http://www.cp2k.org/">CP2K homepage</A>'
01006        WRITE(unit_nr,FMT='(A)') "</BODY></HTML>"
01007 
01008        CALL close_file(unit_nr)
01009        CALL section_release(root_section,error=error)
01010 
01011        ! References
01012        CALL open_file(unit_number=unit_nr,file_name="references.html",&
01013             file_action="WRITE", file_status="REPLACE")
01014        WRITE(unit_nr,FMT='(A)') "<HTML><BODY><HEAD><TITLE>The cp2k literature list</TITLE>"
01015        WRITE(unit_nr,FMT='(A)') "<H1>CP2K references</H1>"
01016        CALL print_all_references(sorted=.TRUE.,cited_only=.FALSE.,&
01017                           FORMAT=print_format_html,unit=unit_nr)
01018        WRITE(unit_nr,FMT='(A)') '<BR><hr>Back to the <A HREF="http://www.cp2k.org/">CP2K homepage</A>'
01019        WRITE(unit_nr,FMT='(A)') "</BODY></HTML>"
01020        CALL close_file(unit_nr)
01021 
01022        ! Units
01023        CALL open_file(unit_number=unit_nr,file_name="units.html",&
01024             file_action="WRITE", file_status="REPLACE")
01025        WRITE(unit_nr,FMT='(A)') "<HTML><BODY><HEAD><TITLE>The cp2k units list</TITLE>"
01026        WRITE(unit_nr,FMT='(A)') "<H1>CP2K Available Units of Measurement</H1>"
01027        CALL print_all_units(unit_nr=unit_nr)
01028        WRITE(unit_nr,FMT='(A)') '<BR><hr>Back to the <A HREF="http://www.cp2k.org/">CP2K homepage</A>'
01029        WRITE(unit_nr,FMT='(A)') "</BODY></HTML>"
01030        CALL close_file(unit_nr)
01031     END IF
01032   END SUBROUTINE write_cp2k_html_manual
01033 
01034 ! *****************************************************************************
01035   SUBROUTINE write_xml_file(error)
01036 
01037     TYPE(cp_error_type), INTENT(INOUT)       :: error
01038 
01039     CHARACTER(LEN=*), PARAMETER :: routineN = 'write_xml_file', 
01040       routineP = moduleN//':'//routineN
01041 
01042     INTEGER                                  :: i, ie, is, unit_number
01043     LOGICAL                                  :: failure
01044     TYPE(section_type), POINTER              :: root_section
01045 
01046     failure = .FALSE.
01047     IF (.NOT.failure) THEN
01048       NULLIFY(root_section)
01049       CALL create_cp2k_root_section(root_section,error=error)
01050       CALL keyword_release(root_section%keywords(0)%keyword,error)
01051       CALL open_file(unit_number=unit_number,&
01052                      file_name="cp2k_input.xml",&
01053                      file_action="WRITE",&
01054                      file_status="REPLACE")
01055 
01056       WRITE (UNIT=unit_number,FMT="(A)")&
01057         "<?xml version=""1.0"" encoding=""ISO-8859-1""?>",&
01058         "<?xml-stylesheet type=""text/xsl"" href=""cp2k_input.xsl""?>",&
01059         "<!DOCTYPE documentElement["
01060 
01061       DO i=1,SIZE(html_entity_table),2
01062          is = INDEX(html_entity_table(i),"&") + 1
01063          CPPostcondition((is > 0),cp_failure_level,routineP,error,failure)
01064          ie = INDEX(html_entity_table(i),";") - 1
01065          CPPostcondition((ie >= is),cp_failure_level,routineP,error,failure)
01066          WRITE (UNIT=unit_number,FMT="(A)")&
01067           "<!ENTITY "//html_entity_table(i)(is:ie)//" """//TRIM(html_entity_table(i+1))//""">"
01068       END DO
01069 
01070       WRITE (UNIT=unit_number,FMT="(A)")&
01071         "]>",&
01072         "<CP2K_INPUT>",&
01073         " <CP2K_VERSION>"//TRIM(cp2k_version)//"</CP2K_VERSION>",&
01074         " <CP2K_YEAR>"//TRIM(cp2k_year)//"</CP2K_YEAR>",&
01075         " <COMPILE_DATE>"//TRIM(compile_date)//"</COMPILE_DATE>",&
01076         " <COMPILE_REVISION>"//TRIM(compile_revision)//"</COMPILE_REVISION>"
01077 
01078       DO i=1,root_section%n_subsections
01079          CALL write_section_xml(root_section%subsections(i)%section,1,unit_number,error)
01080       END DO
01081       WRITE (UNIT=unit_number,FMT="(A)") "</CP2K_INPUT>"
01082       CALL close_file(unit_number=unit_number)
01083       CALL section_release(root_section,error=error)
01084 
01085       ! References
01086       CALL open_file(unit_number=unit_number,file_name="references.html",&
01087            file_action="WRITE", file_status="REPLACE")
01088       WRITE(unit_number,FMT='(A)') "<HTML><BODY><HEAD><TITLE>The cp2k literature list</TITLE>"
01089       WRITE(unit_number,FMT='(A)') "<H1>CP2K references</H1>"
01090       CALL print_all_references(sorted=.TRUE.,cited_only=.FALSE., &
01091                           FORMAT=print_format_html,unit=unit_number)
01092       WRITE(unit_number,FMT='(A)') "</BODY></HTML>"
01093       CALL close_file(unit_number=unit_number)
01094 
01095       ! Units
01096       CALL open_file(unit_number=unit_number,file_name="units.html",&
01097            file_action="WRITE", file_status="REPLACE")
01098       WRITE(unit_number,FMT='(A)') "<HTML><BODY><HEAD><TITLE>The cp2k units list</TITLE>"
01099       WRITE(unit_number,FMT='(A)') "<H1>CP2K Available Units of Measurement</H1>"
01100       CALL print_all_units(unit_nr=unit_number)
01101       WRITE(unit_number,FMT='(A)') "</BODY></HTML>"
01102       CALL close_file(unit_number=unit_number)
01103     END IF
01104 
01105   END SUBROUTINE write_xml_file
01106 
01107 ! *****************************************************************************
01119   SUBROUTINE run_input(input_file_path,output_file_path,ierr,mpi_comm)
01120     CHARACTER(len=*), INTENT(in)             :: input_file_path, 
01121                                                 output_file_path
01122     INTEGER, INTENT(out)                     :: ierr
01123     INTEGER, INTENT(in), OPTIONAL            :: mpi_comm
01124 
01125     CHARACTER(len=*), PARAMETER :: routineN = 'run_input', 
01126       routineP = moduleN//':'//routineN
01127 
01128     INTEGER                                  :: unit_nr
01129     LOGICAL                                  :: failure, success
01130     TYPE(cp_error_type)                      :: error
01131     TYPE(cp_para_env_type), POINTER          :: para_env
01132 
01133     failure=.FALSE.
01134     IF (PRESENT(mpi_comm)) THEN
01135        NULLIFY(para_env)
01136        CALL cp_para_env_create(para_env, group=mpi_comm, owns_group=.FALSE.,error=error) !XXXXXXXXXXXX uninitiliased error
01137     ELSE
01138        para_env => f77_default_para_env
01139        CALL cp_para_env_retain(para_env,error=error) !XXXXXXXXXXXX uninitiliased error
01140     END IF
01141     IF (para_env%mepos==para_env%source) THEN
01142        IF (output_file_path=="__STD_OUT__") THEN
01143           unit_nr=6
01144        ELSE
01145           CALL open_file(file_name=output_file_path,file_status="UNKNOWN",&
01146                file_action="WRITE", file_position="APPEND",&
01147                unit_number=unit_nr)
01148        END IF
01149     ELSE
01150        unit_nr=-1
01151     END IF
01152     success=cp2k_run(input_file_path,unit_nr,para_env%group)
01153     IF (.NOT.success) THEN
01154        ierr=cp_failure_level
01155     ELSE
01156        ierr=0
01157     END IF
01158     CALL cp_para_env_release(para_env,error=error) !XXXXXXXXXXXX uninitiliased error
01159   END SUBROUTINE run_input
01160 
01161 END MODULE cp2k_runs