Ignore:
Timestamp:
01/09/14 09:56:11 (10 years ago)
Author:
ymipsl
Message:

Add new openMP parallelism based on distribution of domains on threads. There is no more limitation of number of threads by MPI process.

YM

File:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/timeloop_gcm.f90

    r174 r186  
    77 
    88  INTEGER, PARAMETER :: euler=1, rk4=2, mlf=3 
    9   INTEGER  :: itau_sync=10 
    10  
    11   TYPE(t_message) :: req_ps0, req_mass0, req_theta_rhodz0, req_u0, req_q0 
    12  
    13   TYPE(t_field),POINTER :: f_q(:) 
    14   TYPE(t_field),POINTER :: f_rhodz(:), f_mass(:), f_massm1(:), f_massm2(:), f_dmass(:) 
    15   TYPE(t_field),POINTER :: f_phis(:), f_ps(:),f_psm1(:), f_psm2(:), f_dps(:) 
    16   TYPE(t_field),POINTER :: f_u(:),f_um1(:),f_um2(:), f_du(:) 
    17   TYPE(t_field),POINTER :: f_theta_rhodz(:),f_theta_rhodzm1(:),f_theta_rhodzm2(:), f_dtheta_rhodz(:) 
    18   TYPE(t_field),POINTER :: f_hflux(:), f_wflux(:), f_hfluxt(:), f_wfluxt(:)   
    19  
    20   INTEGER :: nb_stage, matsuno_period, scheme     
     9  INTEGER, PARAMETER :: itau_sync=10 
     10 
     11  TYPE(t_message),SAVE :: req_ps0, req_mass0, req_theta_rhodz0, req_u0, req_q0 
     12 
     13  TYPE(t_field),POINTER,SAVE :: f_q(:) 
     14  TYPE(t_field),POINTER,SAVE :: f_rhodz(:), f_mass(:), f_massm1(:), f_massm2(:), f_dmass(:) 
     15  TYPE(t_field),POINTER,SAVE :: f_phis(:), f_ps(:),f_psm1(:), f_psm2(:), f_dps(:) 
     16  TYPE(t_field),POINTER,SAVE :: f_u(:),f_um1(:),f_um2(:), f_du(:) 
     17  TYPE(t_field),POINTER,SAVE :: f_theta_rhodz(:),f_theta_rhodzm1(:),f_theta_rhodzm2(:), f_dtheta_rhodz(:) 
     18  TYPE(t_field),POINTER,SAVE :: f_hflux(:), f_wflux(:), f_hfluxt(:), f_wfluxt(:)   
     19 
     20  INTEGER,SAVE :: nb_stage, matsuno_period, scheme     
     21!$OMP THREADPRIVATE(nb_stage, matsuno_period, scheme) 
    2122 
    2223  REAL(rstd),SAVE :: jD_cur, jH_cur 
     24!$OMP THREADPRIVATE(jD_cur, jH_cur)   
    2325  REAL(rstd),SAVE :: start_time 
    24  
     26!$OMP THREADPRIVATE(start_time) 
    2527CONTAINS 
    2628   
    … …  
    3941  USE transfert_mod 
    4042  USE check_conserve_mod 
    41   USE ioipsl 
    4243  USE output_field_mod 
    4344  USE write_field 
    … …  
    4748 
    4849!---------------------------------------------------- 
    49   IF (TRIM(time_style)=='lmd')  Then 
    50  
    51    day_step=180 
    52    CALL getin('day_step',day_step) 
    53  
    54    ndays=1 
    55    CALL getin('ndays',ndays) 
    56  
    57    dt = daysec/REAL(day_step) 
    58    itaumax = ndays*day_step 
    59  
    60    calend = 'earth_360d' 
    61    CALL getin('calend', calend) 
    62  
    63    day_ini = 0 
    64    CALL getin('day_ini',day_ini) 
    65  
    66    day_end = 0 
    67    CALL getin('day_end',day_end) 
    68  
    69    annee_ref = 1998 
    70    CALL getin('annee_ref',annee_ref) 
    71  
    72    start_time = 0 
    73    CALL getin('start_time',start_time)  
    74  
    75     
    76    write_period=0 
    77    CALL getin('write_period',write_period) 
    78        
    79    write_period=write_period/scale_factor 
    80    itau_out=FLOOR(write_period/dt) 
    81     
    82    PRINT *, 'Output frequency (scaled) set to ',write_period, ' : itau_out = ',itau_out  
    83  
    84   mois = 1 ; heure = 0. 
    85   call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref) 
    86   jH_ref = jD_ref - int(jD_ref)  
    87   jD_ref = int(jD_ref)  
    88    
    89   CALL ioconf_startdate(INT(jD_ref),jH_ref)  
    90   write(*,*)'annee_ref, mois, day_ref, heure, jD_ref' 
    91   write(*,*)annee_ref, mois, day_ref, heure, jD_ref 
    92   write(*,*)"ndays,day_step,itaumax,dt======>" 
    93   write(*,*)ndays,day_step,itaumax,dt 
    94   call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure) 
    95   write(*,*)'jD_ref+jH_ref,an, mois, jour, heure' 
    96   write(*,*)jD_ref+jH_ref,an, mois, jour, heure 
    97   day_end = day_ini + ndays  
    98  END IF  
     50!  IF (TRIM(time_style)=='lmd')  Then 
     51 
     52!   day_step=180 
     53!   CALL getin('day_step',day_step) 
     54 
     55!   ndays=1 
     56!   CALL getin('ndays',ndays) 
     57 
     58!   dt = daysec/REAL(day_step) 
     59!   itaumax = ndays*day_step 
     60 
     61!   calend = 'earth_360d' 
     62!   CALL getin('calend', calend) 
     63 
     64!   day_ini = 0 
     65!   CALL getin('day_ini',day_ini) 
     66 
     67!   day_end = 0 
     68!   CALL getin('day_end',day_end) 
     69 
     70!   annee_ref = 1998 
     71!   CALL getin('annee_ref',annee_ref) 
     72 
     73!   start_time = 0 
     74!   CALL getin('start_time',start_time)  
     75 
     76!    
     77!   write_period=0 
     78!   CALL getin('write_period',write_period) 
     79!       
     80!   write_period=write_period/scale_factor 
     81!   itau_out=FLOOR(write_period/dt) 
     82!    
     83!   PRINT *, 'Output frequency (scaled) set to ',write_period, ' : itau_out = ',itau_out  
     84 
     85!  mois = 1 ; heure = 0. 
     86!  call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref) 
     87!  jH_ref = jD_ref - int(jD_ref)  
     88!  jD_ref = int(jD_ref)  
     89!   
     90!  CALL ioconf_startdate(INT(jD_ref),jH_ref)  
     91!  write(*,*)'annee_ref, mois, day_ref, heure, jD_ref' 
     92!  write(*,*)annee_ref, mois, day_ref, heure, jD_ref 
     93!  write(*,*)"ndays,day_step,itaumax,dt======>" 
     94!  write(*,*)ndays,day_step,itaumax,dt 
     95!  call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure) 
     96!  write(*,*)'jD_ref+jH_ref,an, mois, jour, heure' 
     97!  write(*,*)jD_ref+jH_ref,an, mois, jour, heure 
     98!  day_end = day_ini + ndays  
     99! END IF  
    99100!---------------------------------------------------- 
    100101 
    101102   IF (xios_output) itau_out=1 
     103   IF (.NOT. enable_io) itau_out=HUGE(itau_out) 
    102104 
    103105! Time-independant orography 
    … …  
    178180    CALL init_check_conserve 
    179181    CALL init_physics 
     182 
    180183    CALL etat0(f_ps,f_mass,f_phis,f_theta_rhodz,f_u, f_q) 
    181184 
    … …  
    221224    LOGICAL :: fluxt_zero(ndomain) ! set to .TRUE. to start accumulating fluxes in time 
    222225    LOGICAL, PARAMETER :: check=.FALSE. 
    223  
     226    INTEGER :: start_clock 
     227    INTEGER :: stop_clock 
     228    INTEGER :: rate_clock 
     229     
    224230    CALL caldyn_BC(f_phis, f_wflux) ! set constant values in first/last interfaces 
    225231 
    226 !$OMP BARRIER 
     232!!$OMP BARRIER 
    227233  DO ind=1,ndomain 
    228234     CALL swap_dimensions(ind) 
    … …  
    237243  fluxt_zero=.TRUE. 
    238244 
     245!$OMP MASTER 
     246  CALL SYSTEM_CLOCK(start_clock) 
     247!$OMP END MASTER    
     248 
     249  CALL trace_on 
     250   
    239251  DO it=0,itaumax 
    240252     
    … …  
    242254    IF (MOD(it,itau_sync)==0) THEN 
    243255      CALL send_message(f_ps,req_ps0) 
     256      CALL wait_message(req_ps0) 
    244257      CALL send_message(f_mass,req_mass0) 
     258      CALL wait_message(req_mass0) 
    245259      CALL send_message(f_theta_rhodz,req_theta_rhodz0)  
     260      CALL wait_message(req_theta_rhodz0)  
    246261      CALL send_message(f_u,req_u0) 
     262      CALL wait_message(req_u0) 
    247263      CALL send_message(f_q,req_q0)  
    248       CALL wait_message(req_ps0) 
    249       CALL wait_message(req_mass0) 
    250       CALL wait_message(req_theta_rhodz0)  
    251       CALL wait_message(req_u0) 
    252264      CALL wait_message(req_q0)  
     265 
     266!      CALL wait_message(req_ps0) 
     267!      CALL wait_message(req_mass0) 
     268!      CALL wait_message(req_theta_rhodz0)  
     269!      CALL wait_message(req_u0) 
     270!      CALL wait_message(req_q0)  
    253271    ENDIF 
    254      
    255 !    IF (is_mpi_root) PRINT *,"It No :",It,"   t :",dt*It 
     272 
     273!$OMP MASTER     
     274    IF (is_mpi_root) PRINT *,"It No :",It,"   t :",dt*It 
     275!$OMP END MASTER     
    256276    IF (mod(it,itau_out)==0 ) THEN 
    257277      CALL update_time_counter(dt*it) 
    … …  
    279299 
    280300    IF (MOD(it+1,itau_dissip)==0) THEN 
     301!         CALL send_message(f_ps,req_ps) 
     302!         CALL wait_message(req_ps)   
     303        
    281304       IF(caldyn_eta==eta_mass) THEN 
    282305          DO ind=1,ndomain 
     306             IF (.NOT. assigned_domain(ind)) CYCLE 
    283307             CALL swap_dimensions(ind) 
    284308             CALL swap_geometry(ind) 
    … …  
    287311          END DO 
    288312       ENDIF 
     313!       CALL send_message(f_mass,req_mass) 
     314!       CALL wait_message(req_mass)   
    289315       CALL dissip(f_u,f_du,f_mass,f_phis, f_theta_rhodz,f_dtheta_rhodz) 
     316!       CALL send_message(f_mass,req_mass) 
     317!       CALL wait_message(req_mass)   
    290318       CALL euler_scheme(.FALSE.)  ! update only u, theta 
    291319    END IF 
    … …  
    299327       IF (check) THEN 
    300328         DO ind=1,ndomain 
     329            IF (.NOT. assigned_domain(ind)) CYCLE 
    301330            CALL swap_dimensions(ind) 
    302331            CALL swap_geometry(ind) 
    … …  
    316345!    jH_cur = jH_cur - int(jH_cur) 
    317346    CALL physics(it,jD_cur,jH_cur,f_phis, f_ps, f_theta_rhodz, f_u, f_q) 
     347 
    318348    ENDDO 
    319349 
     350    CALL check_conserve(f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)   
     351 
     352!$OMP MASTER 
     353    CALL SYSTEM_CLOCK(stop_clock) 
     354    CALL SYSTEM_CLOCK(count_rate=rate_clock) 
     355     
     356    IF (mpi_rank==0) THEN  
     357      PRINT *,"Time elapsed : ",(stop_clock-start_clock)*1./rate_clock 
     358    ENDIF   
     359!$OMP END MASTER  
    320360  
    321361  CONTAINS 
    … …  
    329369 
    330370    DO ind=1,ndomain 
     371       IF (.NOT. assigned_domain(ind)) CYCLE 
    331372       CALL swap_dimensions(ind) 
    332373       CALL swap_geometry(ind) 
    … …  
    390431 
    391432            DO ind=1,ndomain 
     433               IF (.NOT. assigned_domain(ind)) CYCLE 
    392434               CALL swap_dimensions(ind) 
    393435               CALL swap_geometry(ind) 
    … …  
    408450            ENDDO 
    409451         ENDIF 
    410          CALL send_message(f_ps,req_ps) 
     452!         CALL send_message(f_ps,req_ps) 
     453!ym no overlap for now          
     454!         CALL wait_message(req_ps)   
    411455       
    412456      ELSE ! Lagrangian coordinate, deal with mass 
    413457         DO ind=1,ndomain 
     458            IF (.NOT. assigned_domain(ind)) CYCLE 
    414459            CALL swap_dimensions(ind) 
    415460            CALL swap_geometry(ind) 
    … …  
    433478            ENDDO 
    434479         END DO 
    435          CALL send_message(f_mass,req_mass) 
     480!         CALL send_message(f_mass,req_mass) 
     481!ym no overlap for now          
     482!         CALL wait_message(req_mass)   
    436483 
    437484      END IF 
    … …  
    439486      ! now deal with other prognostic variables 
    440487      DO ind=1,ndomain 
     488         IF (.NOT. assigned_domain(ind)) CYCLE 
    441489         CALL swap_dimensions(ind) 
    442490         CALL swap_geometry(ind) 
    … …  
    488536      tau = dt/nb_stage 
    489537      DO ind=1,ndomain 
     538        IF (.NOT. assigned_domain(ind)) CYCLE 
    490539        CALL swap_dimensions(ind) 
    491540        CALL swap_geometry(ind) 
Note: See TracChangeset for help on using the changeset viewer.