! ********************************************************************* ! This file contains distributeWorkLoad, fileNameMP ! ! Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann, ! Jan H. Meinke, Sandipan Mohanty ! ! ********************************************************************* !> Calculate the best way to distribute the work load across processors. !! It calculates the average number of interactions and then tries to !! assign a number of interactions to each processor that is as close !! as possible to the average. The routine should be called once for !! every molecule in the system. !! !! @param num_ppr Number of processors per replica !! @param nml index of molecule or zero. !! !! @author Jan H. Meinke !< subroutine distributeWorkLoad(num_ppr,nml) include 'INCL.H' integer i1ms, io, iv, i2ms, ms integer num_ppr, nml integer idxOfFirstVariable, idxOfLastVariable integer at, atct, ivw, i, j, isum, i14 integer totalct, irank, itarget double precision ipps if (nml.eq.0) then idxOfFirstVariable = ivrml1(1) idxOfLastVariable = ivrml1(ntlml) + nvrml(ntlml) -1 i1ms = imsml1(ntlml)+ nmsml(ntlml) do i = 0, MAX_PROC do j = 1, mxml workPerProcessor(j, i) = 0 end do end do else idxOfFirstVariable = ivrml1(nml) idxOfLastVariable = ivrml1(nml) + nvrml(nml) - 1 i1ms = imsml1(nml)+ nmsml(nml) do i = 0, MAX_PROC workPerProcessor(nml, i) = 0 end do end if isum = 0 do io = idxOfLastVariable, idxOfFirstVariable, - 1 iv = iorvr(io) i2ms = i1ms - 1 i1ms = imsvr1(iv) do ms = i1ms, i2ms do at = latms1(ms), latms2(ms) do ivw=ivwat1(at),ivwat2(at) do j=lvwat1(ivw),lvwat2(ivw) isum = isum + 1 end do end do do i14=i14at1(at),i14at2(at) isum = isum + 1 end do end do end do end do ipps = isum / num_ppr write (logString, *) "Total number of interactions:", isum write (logString, *) "Average # of interactions per processor", & ipps totalct = 0 irank = 1 itarget = int(irank * ipps) if (nml.eq.0) then i1ms = imsml1(ntlml)+ nmsml(ntlml) else i1ms = imsml1(nml)+ nmsml(nml) end if do io = idxOfLastVariable, idxOfFirstVariable, - 1 isum = 0 iv = iorvr(io) i2ms = i1ms - 1 i1ms = imsvr1(iv) do ms = i1ms, i2ms do at = latms1(ms), latms2(ms) atct = atct + 1 do ivw=ivwat1(at),ivwat2(at) do j=lvwat1(ivw),lvwat2(ivw) isum = isum + 1 end do end do do i14=i14at1(at),i14at2(at) isum = isum + 1 end do end do end do if ((totalct + isum).gt.itarget) then if((.not.irank.eq.num_ppr) & .and. & (abs(totalct-itarget) & .lt.abs(totalct + isum - itarget))) then workPerProcessor(nml, irank) = io + 1 ! write (logString, *) io + 1, totalct, itarget else workPerProcessor(nml, irank) = io ! write (logString, *) io, totalct + isum, itarget end if irank = irank + 1 itarget = int(irank * ipps) end if totalct = totalct + isum end do workPerProcessor(nml, 0) = idxOfLastVariable + 1 workPerProcessor(nml, num_ppr) = ivrml1(nml) end subroutine distributeWorkLoad !> !! The function fileNameMP takes a template of a file name in the !! variable base. The position of the first and last character that !! may be replaced by rank in the string are given in i1 (first) and !! i2 (last). !! The function returns an empty string if the rank would need more !! characters than is allowed by the template. !! For example, !! \code !! rank = 11 !! fileName = fileNameMP('base_0000.dat', 6, 9, rank) !! write (logString, *), fileName !! \endcode !! will output base_0011.dat. !! !! @param base the base file name, e.g., base_0000.dat. !! @param i1 index of the first character that may be replaced !! @param i2 index of the last character that may be replaced !! @param rank the number that should be inserted into the file name. !! !! @return file name for rank !< character*80 function fileNameMP(base, i1, i2, rank) character*(*) base ! i1, i2: Index of first and last character that can be replaced ! rank: rank of node integer i1, i2, rank fileNameMP = base if ((i2 - i1 + 1).le.log10(1.0 * rank)) then print *,'too few characters available to label ' print *,'filenames with rank = ',rank stop endif ! TODO: Allow arbitrary rank if (rank.lt.10) then write(fileNameMP(i2:i2), '(i1)') rank elseif (rank.lt.100) then write(fileNameMP(i2-1:i2), '(i2)') rank elseif (rank.lt.1000) then write(fileNameMP(i2-2:i2), '(i3)') rank elseif (rank.lt.10000) then write(fileNameMP(i2-3:i2), '(i4)') rank elseif (rank.lt.100000) then write(fileNameMP(i2-4:i2), '(i5)') rank elseif (rank.lt.1000000) then write(fileNameMP(i2-5:i2), '(i6)') rank endif end function fileNameMP ! End fileNameMP !> !! Add messages to log. This routine takes the log (debugging) mes- !! sages and writes them to the log file if the log level is less or !! equal to the maximum log level given by the global variable !! MAXLOGLEVEL. !! !! @author Jan H. Meinke !! !! @param loglevel level at which this message should be added to !! the log. !! @param message message to be written to the log. !! @param rank global rank of this node if running an MPI job zero !! otherwise. !< subroutine addLogMessage(loglevel, message, rank) integer MAXLOGLEVEL, LOGFILEUNIT common /log/MAXLOGLEVEL, LOGFILEUNIT integer :: loglevel, rank character(LEN=*) :: message if (loglevel <= MAXLOGLEVEL) then write(LOGFILEUNIT, *) message end if end subroutine addLogMessage