fleur_job.F90 8.15 KB
Newer Older
1 2 3 4 5
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130
MODULE m_fleur_jobs
    USE m_juDFT
    IMPLICIT NONE
    PRIVATE
    CHARACTER(LEN=30),PARAMETER:: NOT_A_JOBFILE=".__NOT__A__JOBFILE__"

    TYPE t_job
        INTEGER           :: PE_requested
        INTEGER           :: mpi_comm
        CHARACTER(LEN=20) :: directory
    END TYPE

    PUBLIC:: t_job,fleur_job_arguments,fleur_job_init,fleur_job_distribute,fleur_job_execute

CONTAINS
    SUBROUTINE fleur_job_single(jobs)
        TYPE(t_job),ALLOCATABLE,INTENT(OUT)::jobs(:)

        ALLOCATE(jobs(1))
        jobs(1)%PE_requested=0
        jobs(1)%directory="."
    END SUBROUTINE

    SUBROUTINE read_jobfile(jobs,file)
        TYPE(t_job),ALLOCATABLE,INTENT(OUT)::jobs(:)
        CHARACTER(LEN=*)::file

        LOGICAL:: l_file
        INTEGER:: njobs,i
        INQUIRE(FILE=file,EXIST=l_file)
        IF (l_file) THEN
            OPEN(99,FILE=file,STATUS="old")
        ELSE
            WRITE(*,*) "job input file not found"
            WRITE(*,*) "You specified an invalid filename:",file
            STOP "JOB FILE MISSING"
        ENDIF
        !Count the number of lines in job-file
        njobs=0
        DO
            READ(99,*,END=100)
            njobs=njobs+1
        ENDDO
100     REWIND(99)
        ALLOCATE(jobs(njobs))
        DO i=1,njobs
            READ(99,*) jobs(i)%PE_REQUESTED,jobs(i)%directory
        ENDDO
        CLOSE(99)
    END SUBROUTINE

    SUBROUTINE jobs_fromcommandline(jobs,no_jobs)
        TYPE(t_job),ALLOCATABLE,INTENT(INOUT)::jobs(:)
        INTEGER,INTENT(INOUT):: no_jobs

        TYPE(t_job),ALLOCATABLE ::jobs_tmp(:)
        INTEGER:: i
        CHARACTER(LEN=30)::str

        IF(ALLOCATED(jobs)) THEN
            no_jobs=size(jobs)+no_jobs
            ALLOCATE(jobs_tmp(size(jobs)))
            jobs_tmp=jobs
            DEALLOCATE(jobs)
            ALLOCATE(jobs(no_jobs))
            jobs(:size(jobs_tmp))=jobs_tmp
            no_jobs=size(jobs_tmp)+1
            DEALLOCATE(jobs_tmp)
        ELSE
            ALLOCATE(jobs(no_jobs))
            no_jobs=1
        ENDIF

        DO i=1,command_argument_count()
            CALL get_command_argument(i,str)
            IF(adjustl(str)=="-j") THEN
                CALL get_command_argument(i+1,str)
                IF (index(str,":")>1) THEN
                    READ(str(:index(str,":")-1),*) jobs(no_jobs)%PE_requested
                    jobs(no_jobs)%directory=str(index(str,":")+1:)
                    no_jobs=no_jobs+1
                ELSE
                    PRINT *,"Illegal job-description"
                    PRINT *,"You specified:",str
                    STOP "ILLEGAL DESCRIPTION"
                ENDIF
            ENDIF
        ENDDO
    END SUBROUTINE

    SUBROUTINE jobs_on_commandine(jobfile,no_jobs)
        INTEGER,INTENT(OUT)::no_jobs
        CHARACTER(LEN=*)::jobfile

        INTEGER i
        CHARACTER(LEN=30)::str
        jobfile=NOT_A_JOBFILE
        no_jobs=0
        DO i=1,command_argument_count()
            CALL get_command_argument(i,str)
            IF(adjustl(str)=="-j") THEN
                no_jobs=no_jobs+1
            ENDIF
            IF (adjustl(str)=="-f") THEN
                CALL get_command_argument(i+1,jobfile)
            ENDIF
        ENDDO
    END SUBROUTINE

    SUBROUTINE fleur_job_arguments(jobs)
        TYPE(t_job),ALLOCATABLE,INTENT(OUT)::jobs(:)

        CHARACTER(LEN=30):: file
        INTEGER          :: no_jobs_commandline

        CALL jobs_on_commandine(file,no_jobs_commandline)
        IF (file.NE.NOT_A_JOBFILE)  &
            CALL read_jobfile(jobs,file)
        IF (no_jobs_commandline>0) &
            CALL jobs_fromcommandline(jobs,no_jobs_commandline)
        IF (.NOT.allocated(jobs)) &
            CALL fleur_job_single(jobs)
    END SUBROUTINE

    SUBROUTINE fleur_job_init()
131 132
      USE m_fleur_help
      use m_judft
133
        INTEGER:: irank=0
134 135
#ifdef CPP_MPI
      INCLUDE 'mpif.h'
136
        INTEGER ierr(3), i
137
        CALL MPI_INIT_THREAD(MPI_THREAD_FUNNELED,i,ierr)
138
        CALL judft_init()
139
        CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
Daniel Wortmann's avatar
Daniel Wortmann committed
140
        IF(irank.EQ.0) THEN
141
           !$    IF (i<MPI_THREAD_FUNNELED) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
142
           !$       WRITE(*,*) ""
143
           !$       WRITE(*,*) "Linked MPI version does not support multithreading."
Daniel Wortmann's avatar
Daniel Wortmann committed
144 145 146 147 148 149 150 151 152 153
           !$       WRITE(*,*) ""
           !$       WRITE(*,*) "To solve this problem please do one of:"
           !$       WRITE(*,*) "   1. Link an adequate MPI version."
           !$       WRITE(*,*) "   2. Use fleur without MPI."
           !$       WRITE(*,*) "   3. Compile and use fleur without OpenMP."
           !$       WRITE(*,*) ""
           !$       CALL juDFT_error("MPI not usable with OpenMP")
           !$    END IF
           !Select the io-mode from the command-line
        END IF
154
#endif
155 156 157
        IF (irank==0) THEN
           CALL fleur_help()
        END IF
158 159 160 161 162 163 164
    END SUBROUTINE

    SUBROUTINE fleur_job_execute(jobs)
        USE m_fleur
        TYPE(t_job),INTENT(IN) ::jobs(:)

        INTEGER:: njob=1
Matthias Redies's avatar
Matthias Redies committed
165
        INTEGER:: irank=0
166 167

#ifdef CPP_MPI
168
        INTEGER:: ierr
169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
      INCLUDE 'mpif.h'
        CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)

        !find the number of the job for this PE
        DO njob=1,size(jobs)
            IF (jobs(njob)%mpi_comm==MPI_UNDEFINED) CYCLE
            CALL MPI_COMM_RANK(jobs(njob)%mpi_comm,irank,ierr)
            IF (irank.NE.MPI_UNDEFINED) EXIT
        ENDDO
#endif
        if (njob>size(jobs)) THEN
            print *, "GLOBAL-PE:",irank," does nothing"
            return
        endif
        !change directory
        CALL chdir(jobs(njob)%directory)
        !Call FLEUR

        CALL fleur_execute(jobs(njob)%mpi_comm)

    END SUBROUTINE

    SUBROUTINE fleur_job_distribute(jobs)
        TYPE(t_job),INTENT(INOUT)::jobs(:)
#ifdef CPP_MPI
      INCLUDE 'mpif.h'
        INTEGER:: i,free_pe,isize,irank,min_pe,new_comm,ierr

        CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
        CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,ierr)

        if (irank==0) print *,"Running on ",isize," PE"
        !First determine if there are PE that should be distributed automatically
        IF (any(jobs%pe_requested==0)) THEN
            i=count(jobs%pe_requested==0)
            free_pe=isize-sum(jobs%pe_requested)
            if (irank==0) print *,i," jobs are distributed on ",free_pe," unassigned PE"
            i=free_pe/i

            IF (i<1) THEN
                if (irank==0) PRINT *,"Not enough PE after automatic assignment of jobs"
                STOP "NOT enough PE"
            ELSE
                WHERE (jobs%pe_requested==0) jobs%pe_requested=i
            ENDIF
        ENDIF
        free_pe=isize-sum(jobs%pe_requested)
        IF (free_pe<0) THEN
            if (irank==0) PRINT *,"Not enough PE for assignment of jobs"
            STOP "NOT enough PE"
        ENDIF
        IF (free_pe>0.and.irank==0)    PRINT *,"WARNING, there are unused PE"

        !Now create the groups
        DO i=1,size(jobs)
            min_pe=sum(jobs(:i-1)%PE_requested)
            IF ((irank.GE.min_pe).AND.(irank<min_pe+jobs(i)%PE_requested)) EXIT
        ENDDO
        jobs%mpi_comm=MPI_UNDEFINED
        CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,i,irank,new_comm,ierr)
        IF (i.LE.size(jobs)) THEN
230
            if(size(jobs) > 1) PRINT* ,"PE:",irank," works on job ",i," in ",jobs(i)%directory
231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249
            jobs(i)%mpi_comm=new_comm
        ENDIF

#else
        IF (size(jobs)>1) THEN
            PRINT*, "Cannot run multiple jobs without MPI"
            STOP "NO MPI"
        ENDIF
        IF (sum(jobs%pe_requested)>1) THEN
            PRINT*, "You cannot request a multiple PE job without MPI"
            STOP "NO MPI"
        ENDIF
        jobs(1)%mpi_comm=1
#endif
    END SUBROUTINE
END MODULE

PROGRAM fleurjob
    USE m_fleur_jobs
250
    USE m_juDFT
251 252 253 254 255 256 257
    IMPLICIT NONE
    TYPE(t_job),ALLOCATABLE::jobs(:)
    CALL fleur_job_init()
    CALL fleur_job_arguments(jobs)
    CALL fleur_job_distribute(jobs)
    CALL fleur_job_execute(jobs)
END