Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 : MODULE m_fleur_jobs
7 : #ifdef CPP_MPI
8 : use mpi
9 : #endif
10 : USE m_juDFT
11 : IMPLICIT NONE
12 : PRIVATE
13 : CHARACTER(LEN=30),PARAMETER:: NOT_A_JOBFILE=".__NOT__A__JOBFILE__"
14 :
15 : TYPE t_job
16 : INTEGER :: PE_requested
17 : INTEGER :: mpi_comm
18 : CHARACTER(LEN=20) :: directory
19 : END TYPE
20 :
21 : PUBLIC:: t_job,fleur_job_arguments,fleur_job_init,fleur_job_distribute,fleur_job_execute
22 :
23 : CONTAINS
24 160 : SUBROUTINE fleur_job_single(jobs)
25 : TYPE(t_job),ALLOCATABLE,INTENT(OUT)::jobs(:)
26 :
27 160 : ALLOCATE(jobs(1))
28 160 : jobs(1)%PE_requested=0
29 160 : jobs(1)%directory="."
30 160 : END SUBROUTINE
31 :
32 0 : SUBROUTINE read_jobfile(jobs,file)
33 : TYPE(t_job),ALLOCATABLE,INTENT(OUT)::jobs(:)
34 : CHARACTER(LEN=*)::file
35 :
36 : LOGICAL:: l_file
37 : INTEGER:: njobs,i
38 0 : INQUIRE(FILE=file,EXIST=l_file)
39 0 : IF (l_file) THEN
40 0 : OPEN(99,FILE=file,STATUS="old")
41 : ELSE
42 0 : WRITE(*,*) "job input file not found"
43 0 : WRITE(*,*) "You specified an invalid filename:",file
44 0 : STOP "JOB FILE MISSING"
45 : ENDIF
46 : !Count the number of lines in job-file
47 0 : njobs=0
48 : DO
49 0 : READ(99,*,END=100)
50 0 : njobs=njobs+1
51 : ENDDO
52 0 : 100 REWIND(99)
53 0 : ALLOCATE(jobs(njobs))
54 0 : DO i=1,njobs
55 0 : READ(99,*) jobs(i)%PE_REQUESTED,jobs(i)%directory
56 : ENDDO
57 0 : CLOSE(99)
58 0 : END SUBROUTINE
59 :
60 0 : SUBROUTINE jobs_fromcommandline(jobs,no_jobs)
61 : TYPE(t_job),ALLOCATABLE,INTENT(INOUT)::jobs(:)
62 : INTEGER,INTENT(INOUT):: no_jobs
63 :
64 0 : TYPE(t_job),ALLOCATABLE ::jobs_tmp(:)
65 : INTEGER:: i
66 : CHARACTER(LEN=30)::str
67 :
68 0 : IF(ALLOCATED(jobs)) THEN
69 0 : no_jobs=size(jobs)+no_jobs
70 0 : ALLOCATE(jobs_tmp(size(jobs)))
71 0 : jobs_tmp=jobs
72 0 : DEALLOCATE(jobs)
73 0 : ALLOCATE(jobs(no_jobs))
74 0 : jobs(:size(jobs_tmp))=jobs_tmp
75 0 : no_jobs=size(jobs_tmp)+1
76 0 : DEALLOCATE(jobs_tmp)
77 : ELSE
78 0 : ALLOCATE(jobs(no_jobs))
79 0 : no_jobs=1
80 : ENDIF
81 :
82 0 : DO i=1,command_argument_count()
83 0 : CALL get_command_argument(i,str)
84 0 : IF(adjustl(str)=="-j") THEN
85 0 : CALL get_command_argument(i+1,str)
86 0 : IF (index(str,":")>1) THEN
87 0 : READ(str(:index(str,":")-1),*) jobs(no_jobs)%PE_requested
88 0 : jobs(no_jobs)%directory=str(index(str,":")+1:)
89 0 : no_jobs=no_jobs+1
90 : ELSE
91 0 : PRINT *,"Illegal job-description"
92 0 : PRINT *,"You specified:",str
93 0 : STOP "ILLEGAL DESCRIPTION"
94 : ENDIF
95 : ENDIF
96 : ENDDO
97 0 : END SUBROUTINE
98 :
99 160 : SUBROUTINE jobs_on_commandine(jobfile,no_jobs)
100 : INTEGER,INTENT(OUT)::no_jobs
101 : CHARACTER(LEN=*)::jobfile
102 :
103 : INTEGER i
104 : CHARACTER(LEN=30)::str
105 160 : jobfile=NOT_A_JOBFILE
106 160 : no_jobs=0
107 320 : DO i=1,command_argument_count()
108 160 : CALL get_command_argument(i,str)
109 160 : IF(adjustl(str)=="-j") THEN
110 0 : no_jobs=no_jobs+1
111 : ENDIF
112 320 : IF (adjustl(str)=="-f") THEN
113 0 : CALL get_command_argument(i+1,jobfile)
114 : ENDIF
115 : ENDDO
116 160 : END SUBROUTINE
117 :
118 160 : SUBROUTINE fleur_job_arguments(jobs)
119 : TYPE(t_job),ALLOCATABLE,INTENT(OUT)::jobs(:)
120 :
121 : CHARACTER(LEN=30):: file
122 : INTEGER :: no_jobs_commandline
123 :
124 160 : CALL jobs_on_commandine(file,no_jobs_commandline)
125 160 : IF (file.NE.NOT_A_JOBFILE) &
126 0 : CALL read_jobfile(jobs,file)
127 160 : IF (no_jobs_commandline>0) &
128 0 : CALL jobs_fromcommandline(jobs,no_jobs_commandline)
129 160 : IF (.NOT.allocated(jobs)) &
130 : CALL fleur_job_single(jobs)
131 160 : END SUBROUTINE
132 :
133 160 : SUBROUTINE fleur_job_init(l_mpi_multithreaded)
134 : USE m_fleur_help
135 : use m_fleur_version
136 : use m_fleur_dropxmlschema
137 : use m_judft
138 : USE m_constants
139 : logical, intent(out) :: l_mpi_multithreaded
140 : INTEGER :: irank=0
141 : #ifdef CPP_MPI
142 : INTEGER ierr, i
143 160 : CALL MPI_INIT_THREAD(MPI_THREAD_MULTIPLE,i,ierr)
144 160 : if(ierr /= 0) call judft_error("MPI init failed.")
145 : #endif
146 160 : l_mpi_multithreaded = .FALSE.
147 160 : CALL judft_init(oUnit,.FALSE.)
148 : #ifdef CPP_MPI
149 160 : CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
150 0 : select case (i)
151 : case (MPI_THREAD_SINGLE)
152 0 : l_mpi_multithreaded = .False.
153 0 : call judft_error("Fleur does not support: 'MPI_THREAD_SINGLE'. The minimum is 'MPI_THREAD_FUNNELED'")
154 : case (MPI_THREAD_FUNNELED )
155 0 : l_mpi_multithreaded = .False.
156 : case (MPI_THREAD_SERIALIZED)
157 0 : l_mpi_multithreaded = .False.
158 : case (MPI_THREAD_MULTIPLE)
159 160 : l_mpi_multithreaded = .True.
160 : case default
161 160 : call judft_error("Can't identify MPI_Thread lvl")
162 : end select
163 :
164 160 : if(judft_was_argument("-disable_progress_thread")) then
165 0 : l_mpi_multithreaded = .False.
166 : endif
167 :
168 160 : IF(irank.EQ.0) THEN
169 80 : if(.not. l_mpi_multithreaded) then
170 0 : write (*,*) "MPI_THREAD_MULTIPLE is not avalible. This might lead to performance problems"
171 : endif
172 :
173 80 : !$ IF (i<MPI_THREAD_FUNNELED) THEN
174 0 : !$ WRITE(*,*) ""
175 0 : !$ WRITE(*,*) "Linked MPI version does not support multithreading."
176 0 : !$ WRITE(*,*) ""
177 0 : !$ WRITE(*,*) "To solve this problem please do one of:"
178 0 : !$ WRITE(*,*) " 1. Link an adequate MPI version."
179 0 : !$ WRITE(*,*) " 2. Use fleur without MPI."
180 0 : !$ WRITE(*,*) " 3. Compile and use fleur without OpenMP."
181 0 : !$ WRITE(*,*) ""
182 0 : !$ CALL juDFT_error("MPI not usable with OpenMP")
183 : !$ END IF
184 : END IF
185 : #endif
186 160 : IF (irank==0) THEN
187 80 : CALL fleur_help()
188 80 : call fleur_version()
189 80 : call fleur_dropxmlschema()
190 : END IF
191 160 : END SUBROUTINE
192 :
193 160 : SUBROUTINE fleur_job_execute(jobs, l_mpi_multithreaded)
194 : USE m_fleur
195 : USE m_types
196 : USE m_fleur_init
197 :
198 : TYPE(t_job),INTENT(IN) ::jobs(:)
199 : logical, intent(in) :: l_mpi_multithreaded
200 :
201 : !local variables for FLEUR
202 10080 : type(t_fleurinput) :: fi
203 160 : TYPE(t_mpi) :: fmpi
204 160 : TYPE(t_sphhar) :: sphhar
205 640 : TYPE(t_stars) :: stars
206 160 : TYPE(t_enpara) :: enpara
207 160 : TYPE(t_results) :: results
208 640 : TYPE(t_nococonv) :: nococonv
209 2720 : type(t_wann) :: wann
210 160 : TYPE(t_hybdat) :: hybdat
211 160 : type(t_mpdata) :: mpdata
212 160 : CLASS(t_forcetheo),ALLOCATABLE::forcetheo
213 160 : class(t_xcpot), allocatable :: xcpot
214 :
215 : !local variables for jobcontrol
216 : INTEGER:: njob=1
217 : INTEGER:: irank=0
218 :
219 : CHARACTER(len=100) :: filename_add
220 :
221 : #ifdef CPP_MPI
222 : INTEGER:: ierr
223 160 : CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
224 :
225 : !find the number of the job for this PE
226 160 : DO njob=1,size(jobs)
227 160 : IF (jobs(njob)%mpi_comm==MPI_UNDEFINED) CYCLE
228 160 : CALL MPI_COMM_RANK(jobs(njob)%mpi_comm,irank,ierr)
229 160 : IF (irank.NE.MPI_UNDEFINED) EXIT
230 : ENDDO
231 : #endif
232 160 : if (njob>size(jobs)) THEN
233 0 : print *, "GLOBAL-PE:",irank," does nothing"
234 : return
235 : endif
236 : !change directory
237 160 : CALL chdir(jobs(njob)%directory)
238 : !Call FLEUR
239 160 : fmpi%l_mpi_multithreaded = l_mpi_multithreaded
240 160 : fmpi%mpi_comm = jobs(njob)%mpi_comm
241 :
242 160 : call log_start()
243 :
244 160 : CALL timestart("Initialization")
245 160 : filename_add = ""
246 160 : IF (judft_was_argument("-add_name")) filename_add = TRIM(judft_string_for_argument("-add_name"))//"_"//""
247 : call fleur_init(fmpi,fi,sphhar,stars,nococonv,forcetheo,enpara,xcpot,results,wann, hybdat, mpdata, filename_add)
248 160 : CALL timestop("Initialization")
249 :
250 : CALL fleur_execute(fmpi,fi,sphhar,stars,nococonv,forcetheo,enpara,results,&
251 160 : xcpot, wann, hybdat, mpdata)
252 :
253 0 : END SUBROUTINE
254 :
255 160 : SUBROUTINE fleur_job_distribute(jobs)
256 : use m_types_mpi
257 : TYPE(t_job),INTENT(INOUT)::jobs(:)
258 : #ifdef CPP_MPI
259 : INTEGER:: i,free_pe,isize,irank,min_pe,new_comm,ierr
260 :
261 160 : CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
262 160 : CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,ierr)
263 :
264 : !if (irank==0) print *,"Running on ",isize," PE"
265 : !First determine if there are PE that should be distributed automatically
266 160 : IF (any(jobs%pe_requested==0)) THEN
267 320 : i=count(jobs%pe_requested==0)
268 320 : free_pe=isize-sum(jobs%pe_requested)
269 160 : if (irank==0.and.i>1) print *,i," jobs are distributed on ",free_pe," unassigned PE"
270 160 : i=free_pe/i
271 :
272 160 : IF (i<1) THEN
273 0 : if (irank==0) PRINT *,"Not enough PE after automatic assignment of jobs"
274 0 : STOP "NOT enough PE"
275 : ELSE
276 320 : WHERE (jobs%pe_requested==0) jobs%pe_requested=i
277 : ENDIF
278 : ENDIF
279 320 : free_pe=isize-sum(jobs%pe_requested)
280 160 : IF (free_pe<0) THEN
281 0 : if (irank==0) PRINT *,"Not enough PE for assignment of jobs"
282 0 : STOP "NOT enough PE"
283 : ENDIF
284 160 : IF (free_pe>0.and.irank==0) PRINT *,"WARNING, there are unused PE"
285 :
286 : !Now create the groups
287 160 : DO i=1,size(jobs)
288 160 : min_pe=sum(jobs(:i-1)%PE_requested)
289 160 : IF ((irank.GE.min_pe).AND.(irank<min_pe+jobs(i)%PE_requested)) EXIT
290 : ENDDO
291 320 : jobs%mpi_comm=MPI_UNDEFINED
292 160 : CALL judft_comm_split(MPI_COMM_WORLD,i,irank,new_comm)
293 160 : IF (i.LE.size(jobs)) THEN
294 160 : if(size(jobs) > 1) PRINT* ,"PE:",irank," works on job ",i," in ",jobs(i)%directory
295 160 : jobs(i)%mpi_comm=new_comm
296 : ENDIF
297 :
298 : #else
299 : IF (size(jobs)>1) THEN
300 : PRINT*, "Cannot run multiple jobs without MPI"
301 : STOP "NO MPI"
302 : ENDIF
303 : IF (sum(jobs%pe_requested)>1) THEN
304 : PRINT*, "You cannot request a multiple PE job without MPI"
305 : STOP "NO MPI"
306 : ENDIF
307 : jobs(1)%mpi_comm=1
308 : #endif
309 160 : END SUBROUTINE
310 0 : END MODULE
311 :
312 160 : PROGRAM fleurjob
313 160 : USE m_fleur_jobs
314 : USE m_juDFT
315 : IMPLICIT NONE
316 160 : TYPE(t_job),ALLOCATABLE::jobs(:)
317 : logical :: l_mpi_multithreaded
318 160 : CALL fleur_job_init(l_mpi_multithreaded)
319 : CALL fleur_job_arguments(jobs)
320 160 : CALL fleur_job_distribute(jobs)
321 160 : CALL fleur_job_execute(jobs, l_mpi_multithreaded)
322 0 : END PROGRAM fleurjob
|
