LCOV - code coverage report
Current view: top level - main - fleur_job.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 65 126 51.6 %
Date: 2019-09-08 04:53:50 Functions: 8 10 80.0 %

          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             :     USE m_juDFT
       8             :     IMPLICIT NONE
       9             :     PRIVATE
      10             :     CHARACTER(LEN=30),PARAMETER:: NOT_A_JOBFILE=".__NOT__A__JOBFILE__"
      11             : 
      12             :     TYPE t_job
      13             :         INTEGER           :: PE_requested
      14             :         INTEGER           :: mpi_comm
      15             :         CHARACTER(LEN=20) :: directory
      16             :     END TYPE
      17             : 
      18             :     PUBLIC:: t_job,fleur_job_arguments,fleur_job_init,fleur_job_distribute,fleur_job_execute
      19             : 
      20             : CONTAINS
      21          76 :     SUBROUTINE fleur_job_single(jobs)
      22             :         TYPE(t_job),ALLOCATABLE,INTENT(OUT)::jobs(:)
      23             : 
      24          76 :         ALLOCATE(jobs(1))
      25          76 :         jobs(1)%PE_requested=0
      26          76 :         jobs(1)%directory="."
      27          76 :     END SUBROUTINE
      28             : 
      29           0 :     SUBROUTINE read_jobfile(jobs,file)
      30             :         TYPE(t_job),ALLOCATABLE,INTENT(OUT)::jobs(:)
      31             :         CHARACTER(LEN=*)::file
      32             : 
      33             :         LOGICAL:: l_file
      34             :         INTEGER:: njobs,i
      35           0 :         INQUIRE(FILE=file,EXIST=l_file)
      36           0 :         IF (l_file) THEN
      37           0 :             OPEN(99,FILE=file,STATUS="old")
      38             :         ELSE
      39           0 :             WRITE(*,*) "job input file not found"
      40           0 :             WRITE(*,*) "You specified an invalid filename:",file
      41           0 :             STOP "JOB FILE MISSING"
      42             :         ENDIF
      43             :         !Count the number of lines in job-file
      44           0 :         njobs=0
      45             :         DO
      46           0 :             READ(99,*,END=100)
      47           0 :             njobs=njobs+1
      48             :         ENDDO
      49           0 : 100     REWIND(99)
      50           0 :         ALLOCATE(jobs(njobs))
      51           0 :         DO i=1,njobs
      52           0 :             READ(99,*) jobs(i)%PE_REQUESTED,jobs(i)%directory
      53             :         ENDDO
      54           0 :         CLOSE(99)
      55           0 :     END SUBROUTINE
      56             : 
      57           0 :     SUBROUTINE jobs_fromcommandline(jobs,no_jobs)
      58             :         TYPE(t_job),ALLOCATABLE,INTENT(INOUT)::jobs(:)
      59             :         INTEGER,INTENT(INOUT):: no_jobs
      60             : 
      61           0 :         TYPE(t_job),ALLOCATABLE ::jobs_tmp(:)
      62             :         INTEGER:: i
      63             :         CHARACTER(LEN=30)::str
      64             : 
      65           0 :         IF(ALLOCATED(jobs)) THEN
      66           0 :             no_jobs=size(jobs)+no_jobs
      67           0 :             ALLOCATE(jobs_tmp(size(jobs)))
      68           0 :             jobs_tmp=jobs
      69           0 :             DEALLOCATE(jobs)
      70           0 :             ALLOCATE(jobs(no_jobs))
      71           0 :             jobs(:size(jobs_tmp))=jobs_tmp
      72           0 :             no_jobs=size(jobs_tmp)+1
      73           0 :             DEALLOCATE(jobs_tmp)
      74             :         ELSE
      75           0 :             ALLOCATE(jobs(no_jobs))
      76           0 :             no_jobs=1
      77             :         ENDIF
      78             : 
      79           0 :         DO i=1,command_argument_count()
      80           0 :             CALL get_command_argument(i,str)
      81           0 :             IF(adjustl(str)=="-j") THEN
      82           0 :                 CALL get_command_argument(i+1,str)
      83           0 :                 IF (index(str,":")>1) THEN
      84           0 :                     READ(str(:index(str,":")-1),*) jobs(no_jobs)%PE_requested
      85           0 :                     jobs(no_jobs)%directory=str(index(str,":")+1:)
      86           0 :                     no_jobs=no_jobs+1
      87             :                 ELSE
      88           0 :                     PRINT *,"Illegal job-description"
      89           0 :                     PRINT *,"You specified:",str
      90           0 :                     STOP "ILLEGAL DESCRIPTION"
      91             :                 ENDIF
      92             :             ENDIF
      93             :         ENDDO
      94           0 :     END SUBROUTINE
      95             : 
      96          76 :     SUBROUTINE jobs_on_commandine(jobfile,no_jobs)
      97             :         INTEGER,INTENT(OUT)::no_jobs
      98             :         CHARACTER(LEN=*)::jobfile
      99             : 
     100             :         INTEGER i
     101             :         CHARACTER(LEN=30)::str
     102          76 :         jobfile=NOT_A_JOBFILE
     103          76 :         no_jobs=0
     104          76 :         DO i=1,command_argument_count()
     105           0 :             CALL get_command_argument(i,str)
     106           0 :             IF(adjustl(str)=="-j") THEN
     107           0 :                 no_jobs=no_jobs+1
     108             :             ENDIF
     109          76 :             IF (adjustl(str)=="-f") THEN
     110           0 :                 CALL get_command_argument(i+1,jobfile)
     111             :             ENDIF
     112             :         ENDDO
     113         152 :     END SUBROUTINE
     114             : 
     115          76 :     SUBROUTINE fleur_job_arguments(jobs)
     116             :         TYPE(t_job),ALLOCATABLE,INTENT(OUT)::jobs(:)
     117             : 
     118             :         CHARACTER(LEN=30):: file
     119             :         INTEGER          :: no_jobs_commandline
     120             : 
     121          76 :         CALL jobs_on_commandine(file,no_jobs_commandline)
     122          76 :         IF (file.NE.NOT_A_JOBFILE)  &
     123           0 :             CALL read_jobfile(jobs,file)
     124          76 :         IF (no_jobs_commandline>0) &
     125           0 :             CALL jobs_fromcommandline(jobs,no_jobs_commandline)
     126          76 :         IF (.NOT.allocated(jobs)) &
     127             :             CALL fleur_job_single(jobs)
     128          76 :     END SUBROUTINE
     129             : 
     130          76 :     SUBROUTINE fleur_job_init()
     131             :       USE m_fleur_help
     132             :       use m_judft
     133             :         INTEGER:: irank=0
     134             : #ifdef CPP_MPI
     135             :       INCLUDE 'mpif.h'
     136             :         INTEGER ierr(3), i
     137          76 :         CALL MPI_INIT_THREAD(MPI_THREAD_SERIALIZED,i,ierr)
     138          76 :         CALL judft_init()
     139          76 :         CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
     140          76 :         IF(irank.EQ.0) THEN
     141          38 :            !$    IF (i<MPI_THREAD_SERIALIZED) THEN
     142           0 :            !$       WRITE(*,*) ""
     143           0 :            !$       WRITE(*,*) "Linked MPI version does not support OpenMP."
     144           0 :            !$       WRITE(*,*) ""
     145           0 :            !$       WRITE(*,*) "To solve this problem please do one of:"
     146           0 :            !$       WRITE(*,*) "   1. Link an adequate MPI version."
     147           0 :            !$       WRITE(*,*) "   2. Use fleur without MPI."
     148           0 :            !$       WRITE(*,*) "   3. Compile and use fleur without OpenMP."
     149           0 :            !$       WRITE(*,*) ""
     150           0 :            !$       CALL juDFT_error("MPI not usable with OpenMP")
     151             :            !$    END IF
     152             :            !Select the io-mode from the command-line
     153             :         END IF
     154             : #endif
     155          76 :         IF (irank==0) THEN
     156          38 :            CALL fleur_help()
     157             :         END IF
     158          76 :     END SUBROUTINE
     159             : 
     160          76 :     SUBROUTINE fleur_job_execute(jobs)
     161             :         USE m_fleur
     162             :         TYPE(t_job),INTENT(IN) ::jobs(:)
     163             : 
     164             :         INTEGER:: njob=1
     165             :         INTEGER:: irank=0
     166             : 
     167             : #ifdef CPP_MPI
     168             :         INTEGER:: ierr
     169             :       INCLUDE 'mpif.h'
     170          76 :         CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
     171             : 
     172             :         !find the number of the job for this PE
     173          76 :         DO njob=1,size(jobs)
     174          76 :             IF (jobs(njob)%mpi_comm==MPI_UNDEFINED) CYCLE
     175          76 :             CALL MPI_COMM_RANK(jobs(njob)%mpi_comm,irank,ierr)
     176          76 :             IF (irank.NE.MPI_UNDEFINED) EXIT
     177             :         ENDDO
     178             : #endif
     179          76 :         if (njob>size(jobs)) THEN
     180           0 :             print *, "GLOBAL-PE:",irank," does nothing"
     181             :             return
     182             :         endif
     183             :         !change directory
     184          76 :         CALL chdir(jobs(njob)%directory)
     185             :         !Call FLEUR
     186             : 
     187          76 :         CALL fleur_execute(jobs(njob)%mpi_comm)
     188             : 
     189             :     END SUBROUTINE
     190             : 
     191          76 :     SUBROUTINE fleur_job_distribute(jobs)
     192             :         TYPE(t_job),INTENT(INOUT)::jobs(:)
     193             : #ifdef CPP_MPI
     194             :       INCLUDE 'mpif.h'
     195             :         INTEGER:: i,free_pe,isize,irank,min_pe,new_comm,ierr
     196             : 
     197          76 :         CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
     198          76 :         CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,ierr)
     199             : 
     200          76 :         if (irank==0) print *,"Running on ",isize," PE"
     201             :         !First determine if there are PE that should be distributed automatically
     202          76 :         IF (any(jobs%pe_requested==0)) THEN
     203         152 :             i=count(jobs%pe_requested==0)
     204         152 :             free_pe=isize-sum(jobs%pe_requested)
     205          76 :             if (irank==0) print *,i," jobs are distributed on ",free_pe," unassigned PE"
     206          76 :             i=free_pe/i
     207             : 
     208          76 :             IF (i<1) THEN
     209           0 :                 if (irank==0) PRINT *,"Not enough PE after automatic assignment of jobs"
     210           0 :                 STOP "NOT enough PE"
     211             :             ELSE
     212         152 :                 WHERE (jobs%pe_requested==0) jobs%pe_requested=i
     213             :             ENDIF
     214             :         ENDIF
     215         152 :         free_pe=isize-sum(jobs%pe_requested)
     216          76 :         IF (free_pe<0) THEN
     217           0 :             if (irank==0) PRINT *,"Not enough PE for assignment of jobs"
     218           0 :             STOP "NOT enough PE"
     219             :         ENDIF
     220          76 :         IF (free_pe>0.and.irank==0)    PRINT *,"WARNING, there are unused PE"
     221             : 
     222             :         !Now create the groups
     223          76 :         DO i=1,size(jobs)
     224          76 :             min_pe=sum(jobs(:i-1)%PE_requested)
     225          76 :             IF ((irank.GE.min_pe).AND.(irank<min_pe+jobs(i)%PE_requested)) EXIT
     226             :         ENDDO
     227         152 :         jobs%mpi_comm=MPI_UNDEFINED
     228          76 :         CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,i,irank,new_comm,ierr)
     229          76 :         IF (i.LE.size(jobs)) THEN
     230          76 :             if(size(jobs) > 1) PRINT* ,"PE:",irank," works on job ",i," in ",jobs(i)%directory
     231          76 :             jobs(i)%mpi_comm=new_comm
     232             :         ENDIF
     233             : 
     234             : #else
     235             :         IF (size(jobs)>1) THEN
     236             :             PRINT*, "Cannot run multiple jobs without MPI"
     237             :             STOP "NO MPI"
     238             :         ENDIF
     239             :         IF (sum(jobs%pe_requested)>1) THEN
     240             :             PRINT*, "You cannot request a multiple PE job without MPI"
     241             :             STOP "NO MPI"
     242             :         ENDIF
     243             :         jobs(1)%mpi_comm=1
     244             : #endif
     245          76 :     END SUBROUTINE
     246             : END MODULE
     247             : 
     248          76 : PROGRAM fleurjob
     249          76 :     USE m_fleur_jobs
     250             :     USE m_juDFT
     251             :     IMPLICIT NONE
     252          76 :     TYPE(t_job),ALLOCATABLE::jobs(:)
     253          76 :     CALL fleur_job_init()
     254             :     CALL fleur_job_arguments(jobs)
     255          76 :     CALL fleur_job_distribute(jobs)
     256          76 :     CALL fleur_job_execute(jobs)
     257          76 : END

Generated by: LCOV version 1.13