udo/exoplasim
Private
Public Access
1
0 Fork 0
Code Activity

change declarations in plasim/src/mpimod.f90 for intel compatibility

Browse Source
This commit is contained in:
Edilbert committed 2016-02-09 10:59:57 +01:00
1 parent 100913dd08
commit 24fa75e78e
1 file changed
+50 -45
Download Patch File Download Diff File Expand all files Collapse all files
plasim/src/mpimod.f90
+50 -45
View File
@@ -21,6 +21,7 @@
subroutine mpbci(k) ! broadcast 1 integer
use mpimod
integer :: k(*)
call mpi_bcast(k,1,mpi_itype,NROOT,myworld,mpinfo)
@@ -34,7 +35,7 @@
subroutine mpbcin(k,n) ! broadcast n integer
use mpimod
integer k(n)
integer :: k(n)
call mpi_bcast(k,n,mpi_itype,NROOT,myworld,mpinfo)
@@ -47,6 +48,7 @@
subroutine mpbcr(p) ! broadcast 1 real
use mpimod
REAL :: p(*)
call mpi_bcast(p,1,mpi_rtype,NROOT,myworld,mpinfo)
@@ -59,8 +61,7 @@
subroutine mpbcrn(p,n) ! broadcast n real
use mpimod
real p(n)
real :: p(n)
call mpi_bcast(p,n,mpi_rtype,NROOT,myworld,mpinfo)
@@ -71,11 +72,11 @@
! SUBROUTINE MPBCL
! ================
subroutine mpbcl(k) ! broadcast 1 logical
subroutine mpbcl(l) ! broadcast 1 logical
use mpimod
logical k
logical :: l(*)
call mpi_bcast(k,1,mpi_ltype,NROOT,myworld,mpinfo)
call mpi_bcast(l,1,mpi_ltype,NROOT,myworld,mpinfo)
return
end subroutine mpbcl
@@ -87,10 +88,9 @@
subroutine mpscin(k,n) ! scatter n integer
use mpimod
integer k(*)
integer :: k(n)
call mpi_scatter(k,n,mpi_itype,k,n,mpi_itype &
& ,NROOT,myworld,mpinfo)
call mpi_scatter(k,n,mpi_itype,k,n,mpi_itype,NROOT,myworld,mpinfo)
return
end subroutine mpscin
@@ -102,7 +102,7 @@
subroutine mpscrn(p,n) ! scatter n real
use mpimod
real p(*)
real :: p(*)
call mpi_scatter(p,n,mpi_rtype,p,n,mpi_rtype,NROOT,myworld,mpinfo)
@@ -130,12 +130,12 @@
subroutine mpscgp(pf,pp,klev) ! scatter gridpoint fields
use mpimod
real pf(NUGP,klev)
real pp(NHOR,klev)
real :: pf(NUGP,klev)
real :: pp(NHOR,klev)
do jlev = 1 , klev
call mpi_scatter(pf(1,jlev),NHOR,mpi_rtype, &
& pp(1,jlev),NHOR,mpi_rtype, &
call mpi_scatter(pf(:,jlev),NHOR,mpi_rtype, &
& pp(:,jlev),NHOR,mpi_rtype, &
& NROOT,myworld,mpinfo)
enddo
@@ -149,12 +149,12 @@
subroutine mpgagp(pf,pp,klev) ! gather gridpoint fields
use mpimod
real pf(NLON*NLAT,klev)
real pp(NHOR,klev)
real :: pf(NLON*NLAT,klev)
real :: pp(NHOR,klev)
do jlev = 1 , klev
call mpi_gather(pp(1,jlev),NHOR,mpi_rtype, &
& pf(1,jlev),NHOR,mpi_rtype, &
call mpi_gather(pp(:,jlev),NHOR,mpi_rtype, &
& pf(:,jlev),NHOR,mpi_rtype, &
& NROOT,myworld,mpinfo)
enddo
@@ -168,12 +168,12 @@
subroutine mpgallgp(pf,pp,klev) ! gather gritpoint to all
use mpimod
real pf(NLON*NLAT,klev)
real pp(NHOR,klev)
real :: pf(NLON*NLAT,klev)
real :: pp(NHOR,klev)
do jlev = 1 , klev
call mpi_allgather(pp(1,jlev),NHOR,mpi_rtype, &
& pf(1,jlev),NHOR,mpi_rtype, &
call mpi_allgather(pp(:,jlev),NHOR,mpi_rtype, &
& pf(:,jlev),NHOR,mpi_rtype, &
& myworld,mpinfo)
enddo
@@ -187,12 +187,12 @@
subroutine mpscsp(pf,pp,klev) ! scatter spectral fields
use mpimod
real pf(NESP,klev)
real pp(NSPP,klev)
real :: pf(NESP,klev)
real :: pp(NSPP,klev)
do jlev = 1 , klev
call mpi_scatter(pf(1,jlev),NSPP,mpi_rtype &
& ,pp(1,jlev),NSPP,mpi_rtype &
call mpi_scatter(pf(:,jlev),NSPP,mpi_rtype &
& ,pp(:,jlev),NSPP,mpi_rtype &
& ,NROOT,myworld,mpinfo)
enddo
@@ -206,12 +206,12 @@
subroutine mpgasp(pf,pp,klev) ! gather spectral fields
use mpimod
real pf(NESP,klev)
real pp(NSPP,klev)
real :: pf(NESP,klev)
real :: pp(NSPP,klev)
do jlev = 1 , klev
call mpi_gather(pp(1,jlev),NSPP,mpi_rtype &
& ,pf(1,jlev),NSPP,mpi_rtype &
call mpi_gather(pp(:,jlev),NSPP,mpi_rtype &
& ,pf(:,jlev),NSPP,mpi_rtype &
& ,NROOT,myworld,mpinfo)
enddo
@@ -225,11 +225,11 @@
subroutine mpgacs(pcs) ! gather cross sections
use mpimod
real pcs(NLAT,NLEV)
real :: pcs(NLAT,NLEV)
do jlev = 1 , NLEV
call mpi_gather(pcs(1,jlev),NLPP,mpi_rtype &
& ,pcs(1,jlev),NLPP,mpi_rtype &
call mpi_gather(pcs(:,jlev),NLPP,mpi_rtype &
& ,pcs(:,jlev),NLPP,mpi_rtype &
& ,NROOT,myworld,mpinfo)
enddo
@@ -243,12 +243,12 @@
subroutine mpgallsp(pf,pp,klev) ! gather spectral to all
use mpimod
real pf(NESP,klev)
real pp(NSPP,klev)
real :: pf(NESP,klev)
real :: pp(NSPP,klev)
do jlev = 1 , klev
call mpi_allgather(pp(1,jlev),NSPP,mpi_rtype &
& ,pf(1,jlev),NSPP,mpi_rtype &
call mpi_allgather(pp(:,jlev),NSPP,mpi_rtype &
& ,pf(:,jlev),NSPP,mpi_rtype &
& ,myworld,mpinfo)
enddo
@@ -262,10 +262,10 @@
subroutine mpsum(psp,klev) ! sum spectral fields
use mpimod
real psp(NESP,klev)
real tmp(NESP,klev)
real :: psp(NESP*klev)
real :: tmp(NESP*klev)
call mpi_reduce(psp(1,1),tmp(1,1),NESP*klev,mpi_rtype,MPI_SUM &
call mpi_reduce(psp,tmp,NESP*klev,mpi_rtype,MPI_SUM &
& ,NROOT,myworld,mpinfo)
if (mypid == NROOT) psp = tmp
@@ -279,11 +279,11 @@
subroutine mpsumsc(psf,psp,klev) ! sum & scatter spectral
use mpimod
real psf(NESP,klev)
real psp(NSPP,klev)
real :: psf(NESP,klev)
real :: psp(NSPP,klev)
do jlev = 1 , klev
call mpi_reduce_scatter(psf(1,jlev),psp(1,jlev),nscatsp &
call mpi_reduce_scatter(psf(:,jlev),psp(:,jlev),nscatsp &
& ,mpi_rtype,MPI_SUM,myworld,mpinfo)
enddo
@@ -660,10 +660,11 @@
character (len=*) :: yn
real :: p(kdim,klev)
real :: z(NUGP,klev)
integer :: iread(1)
if (mypid == NROOT) call get_surf_array(yn,z,NUGP,klev,iread)
call mpbci(iread)
if (iread == 1) call mpscgp(z,p,klev)
if (iread(1) == 1) call mpscgp(z,p,klev)
return
end subroutine mpsurfgp
@@ -677,8 +678,10 @@
use mpimod
real :: p(kdim,klev)
real :: pmax(1)
real zmax(1)
zmax = maxval(p(:,:))
zmax(1) = maxval(p(:,:))
call mpi_allreduce(zmax,pmax,1,mpi_rtype,MPI_MAX,myworld,mpinfo)
return
@@ -693,6 +696,8 @@
use mpimod
real :: p(kdim,klev)
real :: psum(1)
real :: zsum(1)
zsum = sum(p(:,:))
call mpi_allreduce(zsum,psum,1,mpi_rtype,MPI_SUM,myworld,mpinfo)