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/dissip_gcm.f90

    r286 r295  
    7171  USE time_mod 
    7272  USE transfert_omp_mod 
     73  USE omp_para 
    7374  IMPLICIT NONE 
    7475   
    … …  
    100101   CASE('none') 
    101102      rayleigh_friction_type=0 
    102       IF (is_mpi_root) PRINT *, 'No Rayleigh friction' 
     103      IF (is_master) PRINT *, 'No Rayleigh friction' 
    103104   CASE('dcmip2_schaer_noshear') 
    104105      rayleigh_friction_type=1 
    105106      rayleigh_shear=0 
    106       IF (is_mpi_root) PRINT *, 'Rayleigh friction : Schaer-like mountain without shear DCMIP2.1' 
     107      IF (is_master) PRINT *, 'Rayleigh friction : Schaer-like mountain without shear DCMIP2.1' 
    107108   CASE('dcmip2_schaer_shear') 
    108109      rayleigh_shear=1 
    109110      rayleigh_friction_type=2 
    110       IF (is_mpi_root) PRINT *, 'Rayleigh friction : Schaer-like mountain with shear DCMIP2.2' 
     111      IF (is_master) PRINT *, 'Rayleigh friction : Schaer-like mountain with shear DCMIP2.2' 
    111112   CASE DEFAULT 
    112       IF (is_mpi_root) PRINT *, 'Bad selector : rayleigh_friction_type =', TRIM(rayleigh_friction_key), ' in dissip_gcm.f90/init_dissip' 
     113      IF (is_master) PRINT *, 'Bad selector : rayleigh_friction_type =', TRIM(rayleigh_friction_key), ' in dissip_gcm.f90/init_dissip' 
    113114      STOP 
    114115   END SELECT 
    … …  
    119120      rayleigh_tau = rayleigh_tau / scale_factor 
    120121      IF(rayleigh_tau<=0) THEN 
    121          IF (is_mpi_root) PRINT *, 'Forbidden : negative value for rayleigh_friction_tau =',rayleigh_tau 
     122         IF (is_master) PRINT *, 'Forbidden : negative value for rayleigh_friction_tau =',rayleigh_tau 
    122123         STOP 
    123124      END IF 
    … …  
    156157    cdivgrad=-1 
    157158    cgradrot=-1 
    158      
     159 
     160!$OMP BARRIER 
     161!$OMP MASTER 
    159162    DO ind=1,ndomain 
    160       IF (.NOT. assigned_domain(ind)) CYCLE 
    161163      CALL swap_dimensions(ind) 
    162164      CALL swap_geometry(ind) 
    … …  
    175177      ENDDO         
    176178    ENDDO 
    177    
    178  
     179!$OMP END MASTER   
     180!$OMP BARRIER 
    179181 
    180182    DO it=1,20 
    … …  
    184186        CALL transfert_request(f_u,req_e1_vect) 
    185187        DO ind=1,ndomain 
    186           IF (.NOT. assigned_domain(ind)) CYCLE 
     188          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
    187189          CALL swap_dimensions(ind) 
    188190          CALL swap_geometry(ind) 
    … …  
    197199       
    198200      DO ind=1,ndomain 
    199         IF (.NOT. assigned_domain(ind)) CYCLE 
     201        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
    200202        CALL swap_dimensions(ind) 
    201203        CALL swap_geometry(ind) 
    … …  
    214216 
    215217      IF (using_mpi) THEN  
    216         CALL reduce_sum_omp(dumax,dumax1) 
     218        CALL reduce_max_omp(dumax,dumax1) 
    217219!$OMP MASTER         
    218220        CALL MPI_ALLREDUCE(dumax1,dumax,1,MPI_REAL8,MPI_MAX,comm_icosa,ierr) 
    … …  
    220222        CALL bcast_omp(dumax)   
    221223      ELSE 
    222         CALL allreduce_sum_omp(dumax,dumax1) 
     224        CALL allreduce_max_omp(dumax,dumax1) 
    223225        dumax=dumax1 
    224226      ENDIF   
    225227                         
    226228      DO ind=1,ndomain 
    227         IF (.NOT. assigned_domain(ind)) CYCLE 
     229        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
    228230        CALL swap_dimensions(ind) 
    229231        CALL swap_geometry(ind) 
    … …  
    232234        u=du/dumax 
    233235      ENDDO 
    234       IF (is_mpi_root) PRINT *,"gradiv : it :",it ,": dumax",dumax 
     236      IF (is_master) PRINT *,"gradiv : it :",it ,": dumax",dumax 
    235237 
    236238    ENDDO  
    237     IF (is_mpi_root) PRINT *,"gradiv : dumax",dumax 
    238     IF (is_mpi_root) PRINT *, 'mean T-cell edge size (km)', 1.45*radius/iim_glo/1000., & 
     239    IF (is_master) PRINT *,"gradiv : dumax",dumax 
     240    IF (is_master) PRINT *, 'mean T-cell edge size (km)', 1.45*radius/iim_glo/1000., & 
    239241                              'effective T-cell half-edge size (km)', dumax**(-.5/nitergdiv)/1000 
    240     IF (is_mpi_root)  PRINT *, 'Max. time step assuming c=340 m/s and Courant number=2.8 :', & 
     242    IF (is_master)  PRINT *, 'Max. time step assuming c=340 m/s and Courant number=2.8 :', & 
    241243                               2.8/340.*dumax**(-.5/nitergdiv) 
    242244 
    243245    cgraddiv=dumax**(-1./nitergdiv) 
    244     IF (is_mpi_root) PRINT *,"cgraddiv : ",cgraddiv 
    245  
     246    IF (is_master) PRINT *,"cgraddiv : ",cgraddiv 
     247 
     248!$OMP BARRIER 
     249!$OMP MASTER 
    246250    DO ind=1,ndomain 
    247       IF (.NOT. assigned_domain(ind)) CYCLE 
    248251      CALL swap_dimensions(ind) 
    249252      CALL swap_geometry(ind) 
    … …  
    262265      ENDDO         
    263266    ENDDO 
     267!$OMP END MASTER   
     268!$OMP BARRIER 
    264269 
    265270 
    … …  
    270275        CALL transfert_request(f_u,req_e1_vect) 
    271276        DO ind=1,ndomain 
    272           IF (.NOT. assigned_domain(ind)) CYCLE 
     277          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
    273278          CALL swap_dimensions(ind) 
    274279          CALL swap_geometry(ind) 
    … …  
    283288       
    284289      DO ind=1,ndomain 
    285         IF (.NOT. assigned_domain(ind)) CYCLE 
     290        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
    286291        CALL swap_dimensions(ind) 
    287292        CALL swap_geometry(ind) 
    … …  
    300305 
    301306      IF (using_mpi) THEN  
    302         CALL reduce_sum_omp(dumax,dumax1) 
     307        CALL reduce_max_omp(dumax,dumax1) 
    303308!$OMP MASTER         
    304309        CALL MPI_ALLREDUCE(dumax1,dumax,1,MPI_REAL8,MPI_MAX,comm_icosa,ierr) 
    … …  
    306311        CALL bcast_omp(dumax)   
    307312      ELSE 
    308         CALL allreduce_sum_omp(dumax,dumax1) 
     313        CALL allreduce_max_omp(dumax,dumax1) 
    309314        dumax=dumax1 
    310315      ENDIF   
    … …  
    312317       
    313318      DO ind=1,ndomain 
    314         IF (.NOT. assigned_domain(ind)) CYCLE 
     319        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
    315320        CALL swap_dimensions(ind) 
    316321        CALL swap_geometry(ind) 
    … …  
    320325      ENDDO 
    321326       
    322       IF (is_mpi_root) PRINT *,"gradrot : it :",it ,": dumax",dumax 
     327      IF (is_master) PRINT *,"gradrot : it :",it ,": dumax",dumax 
    323328 
    324329    ENDDO  
    325     IF (is_mpi_root) PRINT *,"gradrot : dumax",dumax 
     330    IF (is_master) PRINT *,"gradrot : dumax",dumax 
    326331   
    327332    cgradrot=dumax**(-1./nitergrot)  
    328     IF (is_mpi_root) PRINT *,"cgradrot : ",cgradrot 
     333    IF (is_master) PRINT *,"cgradrot : ",cgradrot 
    329334    
    330335 
    331336 
     337!$OMP BARRIER 
     338!$OMP MASTER 
    332339    DO ind=1,ndomain 
    333       IF (.NOT. assigned_domain(ind)) CYCLE 
    334340      CALL swap_dimensions(ind) 
    335341      CALL swap_geometry(ind) 
    … …  
    344350      ENDDO   
    345351    ENDDO 
     352!$OMP END MASTER 
     353!$OMP BARRIER 
    346354 
    347355    DO it=1,20 
    … …  
    351359        CALL transfert_request(f_theta,req_i1) 
    352360        DO ind=1,ndomain 
    353           IF (.NOT. assigned_domain(ind)) CYCLE 
     361          IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
    354362          CALL swap_dimensions(ind) 
    355363          CALL swap_geometry(ind) 
    … …  
    364372       
    365373      DO ind=1,ndomain 
    366         IF (.NOT. assigned_domain(ind)) CYCLE 
     374        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
    367375        CALL swap_dimensions(ind) 
    368376        CALL swap_geometry(ind) 
    … …  
    379387 
    380388      IF (using_mpi) THEN  
    381         CALL reduce_sum_omp(dthetamax ,dthetamax1) 
     389        CALL reduce_max_omp(dthetamax ,dthetamax1) 
    382390!$OMP MASTER         
    383391        CALL MPI_ALLREDUCE(dthetamax1,dthetamax,1,MPI_REAL8,MPI_MAX,comm_icosa,ierr) 
    … …  
    385393        CALL bcast_omp(dthetamax)   
    386394      ELSE 
    387         CALL allreduce_sum_omp(dthetamax,dthetamax1) 
     395        CALL allreduce_max_omp(dthetamax,dthetamax1) 
    388396        dumax=dumax1 
    389397      ENDIF   
    390398       
    391       IF (is_mpi_root) PRINT *,"divgrad : it :",it ,": dthetamax",dthetamax 
     399      IF (is_master) PRINT *,"divgrad : it :",it ,": dthetamax",dthetamax 
    392400 
    393401      DO ind=1,ndomain 
    394         IF (.NOT. assigned_domain(ind)) CYCLE 
     402        IF (.NOT. assigned_domain(ind) .OR. .NOT. is_omp_level_master) CYCLE 
    395403        CALL swap_dimensions(ind) 
    396404        CALL swap_geometry(ind) 
    … …  
    401409    ENDDO  
    402410 
    403     IF (is_mpi_root) PRINT *,"divgrad : divgrad",dthetamax 
     411    IF (is_master) PRINT *,"divgrad : divgrad",dthetamax 
    404412   
    405413    cdivgrad=dthetamax**(-1./niterdivgrad)  
    406     IF (is_mpi_root) PRINT *,"cdivgrad : ",cdivgrad 
     414    IF (is_master) PRINT *,"cdivgrad : ",cdivgrad 
    407415 
    408416      
    … …  
    431439       dtdissip=itau_dissip*dt 
    432440    ELSE 
    433        IF (is_mpi_root) PRINT *,"No dissipation time set, setting itau_dissip to 1000000000" 
     441       IF (is_master) PRINT *,"No dissipation time set, setting itau_dissip to 1000000000" 
    434442       itau_dissip=100000000 
    435443    END IF 
    436444    itau_dissip=MAX(1,itau_dissip) 
    437     IF (is_mpi_root) PRINT *,"mintau ",mintau,"itau_dissip",itau_dissip," dtdissip ",dtdissip 
     445    IF (is_master) PRINT *,"mintau ",mintau,"itau_dissip",itau_dissip," dtdissip ",dtdissip 
    438446 
    439447  END SUBROUTINE init_dissip  
    … …  
    713721 
    714722    CALL trace_start("divgrad") 
    715         
     723 
    716724    DO ind=1,ndomain 
    717725      IF (.NOT. assigned_domain(ind)) CYCLE 
Note: See TracChangeset for help on using the changeset viewer.