OpenMP langsamer als seriell Fortran90 Code

Question

In meinem Fortran90 Code habe ich einen äußeren Zyklus mit mehreren verschachtelten Schleifen. Um meinen Code zu beschleunigen, habe ich versucht, OpenMP auf der äußeren Schleife zu verwenden, aber ich habe ein sehr seltsames Problem: Wenn ich mehr als 1 Thread verwende, läuft das Programm langsamer als OMP mit 1 Thread, was wiederum langsamer ist als die Verwendung das ursprüngliche serielle Programm (in Bezug auf Wanduhrzeit. Ich versuchte mit 1, 2, 3 oder 4 Fäden). In allen Fällen bekomme ich jedoch das richtige Ergebnis.

Ich führte mehrere Tests auf meinem Code durch und schließlich bemerkte ich, dass das Problem in einer Subroutine ist, denn wenn ich den Aufruf dieser Routine kommentiere, funktioniert mein paralleles Programm wie erwartet, dh je größer die Anzahl der Threads, desto niedriger die Wanduhrzeit.

Nun nimmt diese Routine die Vektoren 4 ein, "ks1", "ks2", "ket1", "ket2" und führt die Vereinigung zwischen "ks1" und "ks2" durch und erhält "kstot". Dann erzeugt es 2 neue Vektoren, "ket1tot" und "ket2tot", wobei ket1tot (i) gleich ket1 (j) ist, wenn ks1tot (i) gleich ks1 (j) ist, ansonsten ket1tot (i) = 0. Das Gleiche gilt für Ket2Tot.

Dann kombiniert die Werte in den Vektoren "ks1tot", "ket1tot", "ket2tot" Ich berechne, welche Linien eines Vektors (matFC) die Werte, die ich brauche, und durch Multiplikation dieser Werte, das Endergebnis erhalten (FCtot).

Also mache ich diese Routine in einem einfachen Programm, Hinzufügen von ersten Zeilen, um das echte Programm nachzuahmen. Ich meine ich fügte hinzu:

1) eine Schleife (auf i), die die äußere Schleife des realen Programms nachahmt, das ich versuche zu parallelisieren;

2) umgesetzt ich die Tatsache, dass jeder Faden auf einer anderen Datei arbeitet (so sollte ich keine falsche Sharing Problem haben)

3) I weitere Schleife hinzugefügt (auf k), das imitiert, dass ich die Routine aufrufen mehrmals.

Hier ist der Code (der Teil, der das ursprüngliche Unterprogramm darstellt, das mir Probleme gibt, ist im Text angegeben):

program evaluatefc 
#ifdef _OPENMP 
use omp_lib 
#endif 
implicit none 
integer::i,ii,j,jj,jjj,k,sizeks1,sizeks2,sizec,sizekstot,NR,NR1,maxnq 
integer::line,ierr,fileunit,mythread,nfreqtot 
real*8::FCtot,time1,time2 
integer,allocatable,dimension(:)::ks1,ket1,ks2,ket2 
integer,dimension(:),allocatable::c,kstot,ket1tot,ket2tot 
real*8,allocatable,dimension(:)::matFC 
character*15,allocatable,dimension(:)::matfileFC 
character::fileFC*15 
real*4::tstarting,tending 
! This program was originally a subroutine 
! that takes in input 4 vectors, ks1, ks2, ket1, ket2 
!--------------------------------------------------------------------------- 
! I initialize some values that in the original subroutine were computed by 
!the main program 
allocate(matfileFC(3),stat=ierr) 
matfileFC(1)='filea.dat' 
matfileFC(2)='fileb.dat' 
matfileFC(3)='filec.dat' 
sizeks1=2 
sizeks2=2 
maxnq=11 
allocate(ks1(sizeks1),stat=ierr) 
allocate(ket1(sizeks1),stat=ierr) 
allocate(ks2(sizeks2),stat=ierr) 
allocate(ket2(sizeks2),stat=ierr) 
nfreqtot=42 
NR1=nfreqtot*(maxnq**2)+nfreqtot   
NR=nfreqtot*(maxnq**2) 
allocate(matFC(NR),stat=ierr) 
!Call two intrinsic to evaluate CPU and wall clock time 
call cpu_time(time1) 
tstarting=secnds(0.0) 
!$OMP PARALLEL DO & 
!$OMP DEFAULT(NONE) & 
!$OMP firstprivate(sizeks1,sizeks2,maxnq,matfileFC,NR,NR1) & 
!$OMP PRIVATE(i,ii,j,jj,k,ierr,mythread,fileunit,c,sizec,line,sizekstot) & 
!$OMP PRIVATE(jjj,ket1,ks1,ket1tot,kstot,ket2,ks2,ket2tot,FCtot,matFC,fileFC) 
do ii=1,3 
    #ifdef _OPENMP 
    mythread=OMP_GET_THREAD_NUM() 
    #else 
    mythread=10 
    #endif 
    fileFC=matfileFC(ii) 
    ! Read some lines of a given file. 
    fileunit=50+mythread 
    open(unit=fileunit,name=fileFC,status='old',form='formatted') 
    read(fileunit,*)!Do not read first line 
    jjj=0 
    do jj=1,NR1-1 
     if(mod(jj,(maxnq**2+1)).eq.0) then 
     read(fileunit,*) 
     else 
     jjj=jjj+1  
     read(fileunit,*)j,k,i,matFC(jjj) 
    ! I actually need only the fourth valor of the line to be stored 
     endif 
    enddo 
    close(fileunit) 
    do k=1,10000000 
     ! Again I initialize the abovementioned values that in the actual 
     ! subroutine are computed by the main program 
     ks1(1)=mod(k,30)+1 
     ks1(2)=mod(k,30)+2 
     ks2(1)=mod(k,17)+1 
     ks2(2)=mod(k,17)+3 
     ket1(1)=mod(k,2) 
     ket1(2)=mod(k,3) 
     ket2(1)=mod(k,5) 
     ket2(2)=mod(k,7) 
     sizec=sizeks1+sizeks2 
     allocate(c(sizec),stat=ierr) 
     do i=1,sizeks1 
      c(i)=ks1(i) 
     enddo 
     do i=sizeks1+1,sizec 
      c(i)=ks2(i-sizeks1) 
     enddo 
     sizekstot=sizec 
     do i=1,sizeks1 
      do j=1,sizeks2 
      if(ks1(i).eq.ks2(j)) then 
       sizekstot=sizekstot-1 
      endif 
      enddo 
     enddo 
     allocate(kstot(sizekstot),stat=ierr) 
     jjj=1 
     i=1 
     jj=0 
     do i=1,sizec-1 
      jjj=jjj+1 
      do j=jjj,sizec 
       if(c(i).eq.c(j)) then 
        exit 
       elseif(c(i).ne.c(j).and.j.eq.sizec) then 
        jj=jj+1 
        kstot(jj)=c(i) 
       endif 
      enddo 
     enddo 
     kstot(sizekstot)=c(sizec) 
     allocate(ket1tot(sizekstot),stat=ierr) 
     do i=1,sizekstot 
      ket1tot(i)=0 
     enddo 
     allocate(ket2tot(sizekstot),stat=ierr) 
     do i=1,sizekstot 
      ket2tot(i)=0 
     enddo 
     do i=1,sizekstot 
      do j=1,sizeks1 
       if(kstot(i).eq.ks1(j))then 
        ket1tot(i)=ket1(j) 
       endif 
      enddo 
     enddo 
     do i=1,sizekstot 
      do j=1,sizeks2 
       if(kstot(i).eq.ks2(j))then 
        ket2tot(i)=ket2(j) 
       endif 
      enddo 
     enddo 
     FCtot=1 
     do i=1,sizekstot 
      line=(kstot(i)-1)*(maxnq)**2+ket1tot(i)*(maxnq)+ket2tot(i)+1 
      FCtot=matFC(line)*FCtot 
     enddo 
     deallocate(c,stat=ierr) 
     deallocate(kstot,stat=ierr) 
     deallocate(ket1tot,stat=ierr) 
     deallocate(ket2tot,stat=ierr) 
    enddo 
enddo 
!$OMP END PARALLEL DO 
call cpu_time(time2) 
tending=secnds(tstarting) 
write(*,*) 
write(*,*)'CPU time is:' 
write(*,*)time2-time1 
write(*,*) 
write(*,*)'Wall clock time is:' 
write(*,*)tending 
end program 

Trotzdem ich das gleiche Problem bekommen, also die Zeit Wanduhr mit 4 Gewinden ist größer als mit 1 Thread.

Zum Beispiel I erhalten (in Sekunden):

Typ WTIME CPU-Zeit

1 Faden 20.37 20.37

4 Gewinde 31,26 91,61

serielle 19.64 19.64

Ich bin mir bewusst, dass die ca ll zur OMP-Bibliothek führt zu einem Overhead, und tatsächlich ist das 1-Thread-OMP-Programm langsamer als das serielle. Aber ich kann nicht verstehen, warum der 4-Thread-OMP-Code langsamer ist.

Ich verwende Intel Fortran Compiler 2013 auf Linux.

Irgendwelche Vorschläge?

Vielen Dank für jede Zeit, die Sie für dieses Problem widmen können.

Answer 1

Ok, ich habe mein eigenes Problem behoben.

Vielen Dank für Ihre Anregungen, insbesondere @Jorge Bellón und @High Performance Mark.

Wie ihre Kommentare sagten, war das Problem tatsächlich die hohe Anzahl der Zuteilung/Freigabe. Wenn ich die Zuordnungen aus den Loops verschiebe oder zumindest wenn ich sie nach der ersten Schleife einsetze, bekomme ich das "normale" OpenMP-Verhalten, d. H. Je größer die Anzahl der Threads ist, desto niedriger ist die Wanduhrzeit.

Für das obige Beispiel beträgt die Wanduhrzeit mit 4 Threads jetzt ungefähr 7 Sekunden.

Vielen Dank für Ihre Hilfe.