[711] | 1 | module mod_phys_openmp |
---|
| 2 | |
---|
| 3 | integer,save :: omp_size |
---|
| 4 | integer,save :: omp_rank |
---|
| 5 | |
---|
| 6 | INTEGER,SAVE,dimension(:),allocatable :: klon_omp_nb |
---|
| 7 | INTEGER,SAVE,dimension(:),allocatable :: klon_omp_begin |
---|
| 8 | INTEGER,SAVE,dimension(:),allocatable :: klon_omp_end |
---|
| 9 | INTEGER,SAVE :: klon_omp |
---|
| 10 | !$OMP THREADPRIVATE(omp_rank,klon_omp) |
---|
| 11 | |
---|
| 12 | REAL,save,allocatable,dimension(:) :: zmasq |
---|
| 13 | !$OMP THREADPRIVATE(zmasq) |
---|
| 14 | |
---|
| 15 | contains |
---|
| 16 | |
---|
| 17 | subroutine init_phys_openmp |
---|
| 18 | USE mod_phys_mpi, only : klon_mpi,kfdia,kidia,kdlon |
---|
| 19 | implicit none |
---|
| 20 | integer :: i |
---|
| 21 | #ifdef _OPENMP |
---|
| 22 | integer :: OMP_GET_NUM_THREADS |
---|
| 23 | external OMP_GET_NUM_THREADS |
---|
| 24 | integer :: OMP_GET_THREAD_NUM |
---|
| 25 | external OMP_GET_THREAD_NUM |
---|
| 26 | #endif |
---|
| 27 | |
---|
| 28 | #ifdef _OPENMP |
---|
| 29 | !$OMP MASTER |
---|
| 30 | omp_size=OMP_GET_NUM_THREADS() |
---|
| 31 | !$OMP END MASTER |
---|
| 32 | omp_rank=OMP_GET_THREAD_NUM() |
---|
| 33 | #else |
---|
| 34 | omp_size=1 |
---|
| 35 | omp_rank=0 |
---|
| 36 | #endif |
---|
| 37 | !$OMP MASTER |
---|
| 38 | print *,'MASTER :omp_rank',omp_rank |
---|
| 39 | allocate(klon_omp_nb(0:omp_size-1)) |
---|
| 40 | allocate(klon_omp_begin(0:omp_size-1)) |
---|
| 41 | allocate(klon_omp_end(0:omp_size-1)) |
---|
| 42 | |
---|
| 43 | do i=0,omp_size-1 |
---|
| 44 | klon_omp_nb(i)=klon_mpi/omp_size |
---|
| 45 | if (i<MOD(klon_mpi,omp_size)) klon_omp_nb(i)=klon_omp_nb(i)+1 |
---|
| 46 | enddo |
---|
| 47 | |
---|
| 48 | klon_omp_begin(0)=1 |
---|
| 49 | klon_omp_end(0)=klon_omp_nb(0) |
---|
| 50 | |
---|
| 51 | do i=1,omp_size-1 |
---|
| 52 | klon_omp_begin(i)=klon_omp_end(i-1)+1 |
---|
| 53 | klon_omp_end(i)=klon_omp_begin(i)+klon_omp_nb(i)-1 |
---|
| 54 | enddo |
---|
| 55 | !$OMP END MASTER |
---|
| 56 | !$OMP BARRIER |
---|
| 57 | |
---|
| 58 | klon_omp=klon_omp_nb(omp_rank) |
---|
| 59 | allocate(zmasq(klon_omp)) |
---|
| 60 | |
---|
| 61 | kidia=1 |
---|
| 62 | kfdia=klon_omp |
---|
| 63 | kdlon=klon_omp |
---|
| 64 | print *,omp_rank,' : klon_omp_nb',klon_omp_nb |
---|
| 65 | end subroutine init_phys_openmp |
---|
| 66 | |
---|
| 67 | |
---|
| 68 | subroutine ScatterField_omp(Fields,Fieldr,ll) |
---|
| 69 | USE mod_phys_mpi, only : klon_mpi |
---|
| 70 | implicit none |
---|
| 71 | INTEGER :: ll |
---|
| 72 | REAL, dimension(klon_mpi,ll) :: Fields |
---|
| 73 | REAL, dimension(klon_omp,ll) :: Fieldr |
---|
| 74 | REAL, dimension(:,:),ALLOCATABLE,SAVE :: Field_tmp |
---|
| 75 | |
---|
| 76 | INTEGER :: i,l,offset |
---|
| 77 | |
---|
| 78 | !$OMP BARRIER |
---|
| 79 | !$OMP MASTER |
---|
| 80 | ALLOCATE(Field_tmp(klon_mpi,ll)) |
---|
| 81 | |
---|
| 82 | DO l=1,ll |
---|
| 83 | DO i=1,klon_mpi |
---|
| 84 | Field_tmp(i,l)=fields(i,l) |
---|
| 85 | ENDDO |
---|
| 86 | ENDDO |
---|
| 87 | |
---|
| 88 | !$OMP END MASTER |
---|
| 89 | |
---|
| 90 | !$OMP BARRIER |
---|
| 91 | offset=klon_omp_begin(omp_rank)-1 |
---|
| 92 | do l=1,ll |
---|
| 93 | do i=1,klon_omp |
---|
| 94 | Fieldr(i,l)=Field_tmp(offset+i,l) |
---|
| 95 | enddo |
---|
| 96 | enddo |
---|
| 97 | !$OMP BARRIER |
---|
| 98 | |
---|
| 99 | !$OMP MASTER |
---|
| 100 | DEALLOCATE(Field_tmp) |
---|
| 101 | !$OMP END MASTER |
---|
| 102 | |
---|
| 103 | end subroutine ScatterField_omp |
---|
| 104 | |
---|
| 105 | subroutine GatherField_omp(Fields,Fieldr,ll) |
---|
| 106 | USE mod_phys_mpi, only : klon_mpi |
---|
| 107 | implicit none |
---|
| 108 | INTEGER :: ll |
---|
| 109 | REAL, dimension(klon_omp,ll) :: Fields |
---|
| 110 | REAL, dimension(klon_mpi,ll) :: Fieldr |
---|
| 111 | REAL, dimension(klon_omp,ll) :: Field_tmp |
---|
| 112 | |
---|
| 113 | INTEGER :: i,l,offset |
---|
| 114 | |
---|
| 115 | Field_tmp(:,:)=Fields(:,:) |
---|
| 116 | !$OMP BARRIER |
---|
| 117 | offset=klon_omp_begin(omp_rank)-1 |
---|
| 118 | do l=1,ll |
---|
| 119 | do i=1,klon_omp |
---|
| 120 | Fieldr(offset+i,l)=Field_tmp(i,l) |
---|
| 121 | enddo |
---|
| 122 | enddo |
---|
| 123 | !$OMP BARRIER |
---|
| 124 | end subroutine GatherField_omp |
---|
| 125 | |
---|
| 126 | end module mod_phys_openmp |
---|