Ignore:
Timestamp:
Sep 24, 2025, 10:24:33 AM (2 months ago)
Author:
rkazeroni
Message:

Add reduce_max functionality, similarly to reduce_min

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_transfert.f90

    r5477 r5829  
    5252  END INTERFACE
    5353
    54 
    55   PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp, reduce_min_omp, omp_barrier
     54  INTERFACE reduce_max_omp
     55    MODULE PROCEDURE reduce_max_omp_i,reduce_max_omp_i1,reduce_max_omp_i2,reduce_max_omp_i3,reduce_max_omp_i4, &
     56                     reduce_max_omp_r,reduce_max_omp_r1,reduce_max_omp_r2,reduce_max_omp_r3,reduce_max_omp_r4
     57  END INTERFACE
     58
     59
     60  PUBLIC bcast_omp,scatter_omp,gather_omp,reduce_sum_omp, reduce_min_omp, reduce_max_omp, omp_barrier
    5661
    5762CONTAINS
     
    841846
    842847
     848  SUBROUTINE reduce_max_omp_i(VarIn, VarOut)
     849    IMPLICIT NONE
     850 
     851    INTEGER,INTENT(IN)  :: VarIn
     852    INTEGER,INTENT(OUT) :: VarOut
     853    INTEGER             :: VarIn_tmp(1)
     854    INTEGER             :: VarOut_tmp(1)
     855   
     856    VarIn_tmp(1)=VarIn
     857    CALL Check_buffer_i(1)   
     858    CALL reduce_max_omp_igen(VarIn_tmp,Varout_tmp,1,buffer_i)
     859    VarOut=VarOut_tmp(1)
     860   
     861  END SUBROUTINE reduce_max_omp_i
     862
     863  SUBROUTINE reduce_max_omp_i1(VarIn, VarOut)
     864    IMPLICIT NONE
     865 
     866    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
     867    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
     868   
     869    CALL Check_buffer_i(size(VarIn))   
     870    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
     871   
     872  END SUBROUTINE reduce_max_omp_i1
     873 
     874 
     875  SUBROUTINE reduce_max_omp_i2(VarIn, VarOut)
     876    IMPLICIT NONE
     877 
     878    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
     879    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
     880
     881    CALL Check_buffer_i(size(VarIn))   
     882    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
     883 
     884  END SUBROUTINE reduce_max_omp_i2
     885
     886
     887  SUBROUTINE reduce_max_omp_i3(VarIn, VarOut)
     888    IMPLICIT NONE
     889 
     890    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
     891    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
     892   
     893    CALL Check_buffer_i(size(VarIn))   
     894    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
     895 
     896  END SUBROUTINE reduce_max_omp_i3
     897
     898
     899  SUBROUTINE reduce_max_omp_i4(VarIn, VarOut)
     900    IMPLICIT NONE
     901
     902    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
     903    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
     904 
     905    CALL Check_buffer_i(size(VarIn))   
     906    CALL reduce_max_omp_igen(VarIn,Varout,Size(VarIn),buffer_i)
     907 
     908  END SUBROUTINE reduce_max_omp_i4
     909
     910
     911  SUBROUTINE reduce_max_omp_r(VarIn, VarOut)
     912    IMPLICIT NONE
     913 
     914    REAL,INTENT(IN)  :: VarIn
     915    REAL,INTENT(OUT) :: VarOut
     916    REAL             :: VarIn_tmp(1)
     917    REAL             :: VarOut_tmp(1)
     918   
     919    VarIn_tmp(1)=VarIn
     920    CALL Check_buffer_r(1)   
     921    CALL reduce_max_omp_rgen(VarIn_tmp,Varout_tmp,1,buffer_r)
     922    VarOut=VarOut_tmp(1)
     923 
     924  END SUBROUTINE reduce_max_omp_r
     925
     926  SUBROUTINE reduce_max_omp_r1(VarIn, VarOut)
     927    IMPLICIT NONE
     928 
     929    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
     930    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
     931   
     932    CALL Check_buffer_r(size(VarIn))   
     933    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
     934   
     935  END SUBROUTINE reduce_max_omp_r1
     936 
     937 
     938  SUBROUTINE reduce_max_omp_r2(VarIn, VarOut)
     939    IMPLICIT NONE
     940 
     941    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
     942    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
     943   
     944    CALL Check_buffer_r(size(VarIn))   
     945    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
     946 
     947  END SUBROUTINE reduce_max_omp_r2
     948
     949
     950  SUBROUTINE reduce_max_omp_r3(VarIn, VarOut)
     951    IMPLICIT NONE
     952 
     953    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
     954    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
     955   
     956    CALL Check_buffer_r(size(VarIn))   
     957    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
     958 
     959  END SUBROUTINE reduce_max_omp_r3
     960
     961
     962  SUBROUTINE reduce_max_omp_r4(VarIn, VarOut)
     963    IMPLICIT NONE
     964
     965    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
     966    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
     967 
     968    CALL Check_buffer_r(size(VarIn))   
     969    CALL reduce_max_omp_rgen(VarIn,Varout,Size(VarIn),buffer_r)
     970 
     971  END SUBROUTINE reduce_max_omp_r4
     972
     973
     974
     975
     976
     977
    843978!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    844979!    LES ROUTINES GENERIQUES    !
     
    12541389
    12551390
     1391  SUBROUTINE reduce_max_omp_igen(VarIn,VarOut,dimsize,Buff)
     1392  IMPLICIT NONE
     1393
     1394    INTEGER,INTENT(IN) :: dimsize
     1395    INTEGER,INTENT(IN),DIMENSION(dimsize) :: VarIn
     1396    INTEGER,INTENT(OUT),DIMENSION(dimsize) :: VarOut
     1397    INTEGER,INTENT(INOUT),DIMENSION(dimsize) :: Buff
     1398
     1399    INTEGER :: i
     1400    INTEGER :: var
     1401
     1402  !$OMP MASTER
     1403    Buff(:)=-HUGE(var)-1
     1404  !$OMP END MASTER
     1405  !$OMP BARRIER
     1406 
     1407  !$OMP CRITICAL     
     1408    DO i=1,dimsize
     1409      Buff(i)=MAX(Buff(i),VarIn(i))
     1410    ENDDO
     1411  !$OMP END CRITICAL
     1412  !$OMP BARRIER 
     1413 
     1414  !$OMP MASTER
     1415    DO i=1,dimsize
     1416      VarOut(i)=Buff(i)
     1417    ENDDO
     1418  !$OMP END MASTER
     1419  !$OMP BARRIER
     1420 
     1421  END SUBROUTINE reduce_max_omp_igen
     1422
     1423  SUBROUTINE reduce_max_omp_rgen(VarIn,VarOut,dimsize,Buff)
     1424  IMPLICIT NONE
     1425
     1426    INTEGER,INTENT(IN) :: dimsize
     1427    REAL,INTENT(IN),DIMENSION(dimsize) :: VarIn
     1428    REAL,INTENT(OUT),DIMENSION(dimsize) :: VarOut
     1429    REAL,INTENT(INOUT),DIMENSION(dimsize) :: Buff
     1430
     1431    INTEGER :: i
     1432    REAL :: var
     1433
     1434  !$OMP MASTER
     1435    Buff(:)=-HUGE(var)-1
     1436  !$OMP END MASTER
     1437  !$OMP BARRIER
     1438 
     1439  !$OMP CRITICAL     
     1440    DO i=1,dimsize
     1441      Buff(i)=MAX(Buff(i),VarIn(i))
     1442    ENDDO
     1443  !$OMP END CRITICAL
     1444  !$OMP BARRIER 
     1445 
     1446  !$OMP MASTER
     1447    DO i=1,dimsize
     1448      VarOut(i)=Buff(i)
     1449    ENDDO
     1450  !$OMP END MASTER
     1451  !$OMP BARRIER
     1452 
     1453  END SUBROUTINE reduce_max_omp_rgen
     1454
     1455
     1456
    12561457END MODULE mod_phys_lmdz_omp_transfert
Note: See TracChangeset for help on using the changeset viewer.