Ignore:
Timestamp:
10/31/14 14:52:01 (10 years ago)
Author:
ymipsl
Message:

Merging OpenMP parallisme mode : by subdomain and on vertical level.
This feature is actually experimental but may be retro-compatible with the last method based only on subdomain

YM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/omp_para.F90

    r186 r295  
    55!$OMP THREADPRIVATE(omp_rank) 
    66 
    7   LOGICAL,SAVE :: omp_first 
    8   LOGICAL,SAVE :: omp_last 
    9   LOGICAL,SAVE :: omp_master 
    10 !$OMP THREADPRIVATE(omp_first, omp_last,omp_master) 
     7  LOGICAL,SAVE :: is_omp_first_level 
     8  LOGICAL,SAVE :: is_omp_last_level 
     9  LOGICAL,SAVE :: is_omp_master 
     10!$OMP THREADPRIVATE(is_omp_first_level, is_omp_last_level,is_omp_master) 
    1111 
    1212  INTEGER,SAVE :: ll_begin 
    … …  
    1717!$OMP THREADPRIVATE(ll_begin,ll_beginp1,ll_end,ll_endm1,ll_endp1) 
    1818  LOGICAL,SAVE :: using_openmp 
    19  
     19   
     20  INTEGER,SAVE :: omp_domain_size 
     21  INTEGER,SAVE :: omp_domain_rank 
     22  INTEGER,SAVE :: omp_level_size 
     23  INTEGER,SAVE :: omp_level_rank 
     24!$OMP THREADPRIVATE( omp_domain_size, omp_level_size,omp_domain_rank,omp_level_rank) 
     25  LOGICAL,SAVE :: is_omp_domain_master 
     26  LOGICAL,SAVE :: is_omp_level_master 
     27!$OMP THREADPRIVATE(is_omp_domain_master,is_omp_level_master ) 
     28   
    2029  LOGICAL,PARAMETER :: omp_by_domain=.TRUE.  
     30  LOGICAL,SAVE :: is_master 
     31!$OMP THREADPRIVATE(is_master) 
     32 
     33 
     34   LOGICAL,SAVE :: is_omp_first_level_full 
     35   LOGICAL,SAVE :: is_omp_last_level_full 
     36   INTEGER,SAVE :: ll_begin_full 
     37   INTEGER,SAVE :: ll_beginp1_full 
     38   INTEGER,SAVE :: ll_end_full 
     39   INTEGER,SAVE :: ll_endm1_full 
     40   INTEGER,SAVE :: ll_endp1_full 
     41!$OMP THREADPRIVATE(is_omp_first_level_full,is_omp_last_level_full)    
     42!$OMP THREADPRIVATE( ll_begin_full, ll_beginp1_full, ll_end_full, ll_endm1_full, ll_endp1_full) 
     43  PRIVATE :: is_omp_first_level_full,is_omp_last_level_full 
     44  PRIVATE :: ll_begin_full, ll_beginp1_full, ll_end_full, ll_endm1_full, ll_endp1_full  
     45   
     46 
     47   LOGICAL,SAVE :: is_omp_first_level_distrib 
     48   LOGICAL,SAVE :: is_omp_last_level_distrib 
     49   INTEGER,SAVE :: ll_begin_distrib 
     50   INTEGER,SAVE :: ll_beginp1_distrib 
     51   INTEGER,SAVE :: ll_end_distrib 
     52   INTEGER,SAVE :: ll_endm1_distrib 
     53   INTEGER,SAVE :: ll_endp1_distrib 
     54!$OMP THREADPRIVATE(is_omp_first_level_distrib,is_omp_last_level_distrib)    
     55!$OMP THREADPRIVATE( ll_begin_distrib, ll_beginp1_distrib, ll_end_distrib, ll_endm1_distrib, ll_endp1_distrib) 
     56 
     57  PRIVATE :: is_omp_first_level_distrib,is_omp_last_level_distrib 
     58  PRIVATE :: ll_begin_distrib, ll_beginp1_distrib, ll_end_distrib, ll_endm1_distrib, ll_endp1_distrib  
     59 
    2160 
    2261CONTAINS 
    2362 
    2463 
    25   SUBROUTINE init_omp_para 
     64  SUBROUTINE init_omp_para(is_mpi_master) 
    2665  USE grid_param 
     66  USE getin_mod 
    2767#ifdef CPP_USING_OMP 
    2868  USE omp_lib 
    2969#endif 
    3070  IMPLICIT NONE 
     71  LOGICAL, INTENT(IN) :: is_mpi_master 
    3172  INTEGER :: ll_nb,i 
    3273 
    … …  
    4990    omp_rank=OMP_GET_THREAD_NUM() 
    5091#endif 
    51  
    52     IF (omp_by_domain) THEN 
    53       omp_first=.TRUE. 
    54       omp_last=.TRUE. 
    55       IF (omp_rank==0) THEN 
    56         omp_master=.TRUE. 
    57       ELSE 
    58         omp_master=.FALSE. 
    59       ENDIF 
    60       
    61       ll_begin=1 
    62       ll_beginp1=2 
    63       ll_end=llm 
    64       ll_endm1=llm-1 
    65       ll_endp1=llm+1 
    66       
    67     ELSE     
    68      
    69       omp_first=.FALSE. 
    70       omp_last=.FALSE. 
    71       omp_master=.FALSE. 
    72      
    73       IF (omp_rank==0) THEN 
    74         omp_first=.TRUE. 
    75         omp_master=.TRUE. 
    76       ENDIF 
    77      
    78       IF (omp_rank==omp_size-1) omp_last=.TRUE. 
    79      
    80       ll_end=0 
    81       DO i=0,omp_rank 
    82         ll_begin=ll_end+1 
    83         ll_nb=llm/omp_size 
    84         IF (MOD(llm,omp_size)>i) ll_nb=ll_nb+1 
    85         ll_end=ll_begin+ll_nb-1 
    86       ENDDO 
    87      
    88       ll_beginp1=ll_begin 
    89       ll_endp1=ll_end 
    90       ll_endm1=ll_end 
    91  
    92       IF (omp_first) ll_beginp1=ll_begin+1 
    93       IF (omp_last) ll_endp1=ll_endp1+1 
    94       IF (omp_last) ll_endm1=ll_endm1-1 
    95      
     92     
     93    is_omp_master=.FALSE. 
     94    is_master=.FALSE. 
     95       
     96    IF (omp_rank==0) THEN 
     97      is_omp_master=.TRUE. 
     98      IF (is_mpi_master) is_master=.TRUE. 
    9699    ENDIF 
     100 
     101    omp_level_size=1  
     102    CALL getin("omp_level_size",omp_level_size) 
     103    IF (MOD(omp_size,omp_level_size)/=0) THEN 
     104      IF (is_mpi_master) PRINT*,"omp_size /= omp_level_size x omp_domain_size  => disable omp threads on vertical layers" 
     105      omp_level_size=1 
     106    ENDIF 
     107    omp_domain_size=omp_size/omp_level_size 
     108    omp_domain_rank = omp_rank / omp_level_size     
     109    omp_level_rank = MOD(omp_rank, omp_level_size)     
     110     
     111    IF (is_mpi_master) PRINT*,"omp_domain_size",omp_domain_size,"omp_domain_rank", omp_domain_rank 
     112    IF (is_mpi_master) PRINT*,"omp_level_size",omp_level_size,"omp_level_rank", omp_level_rank 
     113     
     114    is_omp_first_level=.FALSE. 
     115    is_omp_last_level= .FALSE. 
     116    is_omp_domain_master=.FALSE. 
     117    is_omp_level_master=.FALSE. 
     118 
     119    IF (omp_domain_rank==0) is_omp_domain_master = .TRUE. 
     120    IF (omp_level_rank==0) is_omp_level_master = .TRUE. 
     121    IF (omp_level_rank==0) is_omp_first_level=.TRUE. 
     122     
     123    IF (omp_level_rank==omp_level_size-1) is_omp_last_level=.TRUE. 
     124     
     125    ll_end=0 
     126    DO i=0,omp_level_rank 
     127      ll_begin=ll_end+1 
     128      ll_nb=llm/omp_level_size 
     129      IF (MOD(llm,omp_level_size)>i) ll_nb=ll_nb+1 
     130      ll_end=ll_begin+ll_nb-1 
     131    ENDDO 
     132     
     133    ll_beginp1=ll_begin 
     134    ll_endp1=ll_end 
     135    ll_endm1=ll_end 
     136 
     137    IF (is_omp_first_level) ll_beginp1=ll_begin+1 
     138    IF (is_omp_last_level) ll_endp1=ll_endp1+1 
     139    IF (is_omp_last_level) ll_endm1=ll_endm1-1 
     140     
     141     
     142     
     143    is_omp_first_level_distrib = is_omp_first_level 
     144    is_omp_last_level_distrib  = is_omp_last_level 
     145    ll_begin_distrib           = ll_begin 
     146    ll_beginp1_distrib         = ll_beginp1 
     147    ll_end_distrib             = ll_end 
     148    ll_endm1_distrib           = ll_endm1 
     149    ll_endp1_distrib           = ll_endp1 
     150     
     151    is_omp_first_level_full = .TRUE. 
     152    is_omp_last_level_full  = .TRUE. 
     153    ll_begin_full           = 1 
     154    ll_beginp1_full         = 2 
     155    ll_end_full             = llm 
     156    ll_endm1_full           = llm-1 
     157    ll_endp1_full           = llm+1     
     158 
    97159!$OMP END PARALLEL 
    98160 
    99161   ELSE 
    100162     omp_size=1 
     163     omp_level_size=1 
     164     omp_domain_size=1 
    101165     omp_rank=0 
    102      omp_first=.TRUE. 
    103      omp_last=.TRUE. 
    104      omp_master=.TRUE. 
     166     omp_level_rank=0 
     167     omp_domain_rank=0 
     168     is_omp_first_level=.TRUE. 
     169     is_omp_last_level=.TRUE. 
     170     is_omp_master=.TRUE. 
     171     is_omp_domain_master=.TRUE. 
     172     is_omp_level_master=.TRUE. 
    105173     ll_begin=1 
    106174     ll_beginp1=2 
    … …  
    108176     ll_endm1=llm-1 
    109177     ll_endp1=llm+1 
     178      
     179     is_omp_first_level_distrib = is_omp_first_level 
     180     is_omp_last_level_distrib  = is_omp_last_level 
     181     ll_begin_distrib           = ll_begin 
     182     ll_beginp1_distrib         = ll_beginp1 
     183     ll_end_distrib             = ll_end 
     184     ll_endm1_distrib           = ll_endm1 
     185     ll_endp1_distrib           = ll_endp1 
     186     
     187     is_omp_first_level_full = .TRUE. 
     188     is_omp_last_level_full  = .TRUE. 
     189     ll_begin_full           = 1 
     190     ll_beginp1_full         = 2 
     191     ll_end_full             = llm 
     192     ll_endm1_full           = llm-1 
     193     ll_endp1_full           = llm+1     
     194 
    110195   ENDIF 
    111196    
    112197  END SUBROUTINE init_omp_para 
    113198 
     199 
     200  SUBROUTINE switch_omp_distrib_level 
     201  IMPLICIT NONE 
     202     is_omp_first_level = is_omp_first_level_distrib  
     203     is_omp_last_level  = is_omp_last_level_distrib  
     204     ll_begin           = ll_begin_distrib  
     205     ll_beginp1         = ll_beginp1_distrib  
     206     ll_end             = ll_end_distrib  
     207     ll_endm1           = ll_endm1_distrib  
     208     ll_endp1           = ll_endp1_distrib  
     209   
     210  END SUBROUTINE switch_omp_distrib_level 
     211   
     212 
     213  SUBROUTINE switch_omp_no_distrib_level 
     214  IMPLICIT NONE 
     215 
     216     is_omp_first_level = is_omp_first_level_full  
     217     is_omp_last_level  = is_omp_last_level_full  
     218     ll_begin           = ll_begin_full  
     219     ll_beginp1         = ll_beginp1_full  
     220     ll_end             = ll_end_full  
     221     ll_endm1           = ll_endm1_full  
     222     ll_endp1           = ll_endp1_full  
     223   
     224  END SUBROUTINE switch_omp_no_distrib_level 
     225   
     226 
    114227  FUNCTION omp_in_parallel() 
    115228#ifdef CPP_USING_OMP 
Note: See TracChangeset for help on using the changeset viewer.