00001
00002
00003 subroutine setupcoeff(coeff)
00004
00005 implicit none
00006 include 'param.f90'
00007 integer k,n,blocksize
00008 character*80 fn
00009 integer readwrite,group,fpixel,nelements,status,unit,junk
00010 logical er
00011 real coeff(nx,ny,nz_max,ncoeff,2)
00012 real temp(nx,ny,nz_max),rfull(nx,ny,nz_ghostglobal),rf2(nx,ny,nz_ghostglobal)
00013
00014 readwrite=0
00015 blocksize=1
00016 group=1
00017 fpixel=1
00018 status=0
00019 nelements=nx*ny*nz_ghostglobal
00020 fn="coeff_wavesim.fits"
00021 if(my_rank .eq. 0) then
00022 call ftgiou(unit,status)
00023 call ftopen(unit,fn,readwrite,blocksize,status)
00024 endif
00025
00026 do k=1,ncoeff
00027 if(my_rank .eq. 0) then
00028 call FTMAHD(unit,k,junk,status)
00029 call ftgpve(unit,group,fpixel,nelements,0.,rfull,er,status)
00030 endif
00031 call rdistributeall(rfull,temp)
00032 coeff(:,:,:,k,2)=temp
00033 rf2(:,:,1:nz_ghostglobal-1)=(rfull(:,:,1:nz_ghostglobal-1)&
00034 & +rfull(:,:,2:nz_ghostglobal))/2.
00035 rf2(:,:,nz_ghostglobal)=(rf2(:,:,nz_ghostglobal-1)*2-&
00036 & rf2(:,:,nz_ghostglobal-2))
00037 call mpi_barrier(MPI_COMM_WORLD,ierr)
00038 call rdistributeall(rf2,temp)
00039 coeff(:,:,:,k,1)=temp
00040 enddo
00041 if(my_rank .eq. 0) then
00042 call ftclos(unit, status)
00043 call ftfiou(unit, status)
00044 endif
00045 end subroutine setupcoeff
00046
00047
00048
00049
00050
00051 subroutine rdistributeall(rdinfull,rdin)
00052 include 'param.f90'
00053 real rdinfull(nx,ny,nz_ghostglobal)
00054 real rdin(nx,ny,nz_max)
00055 real temp(nx,ny,nz_max)
00056 if(my_rank .eq. 0) then
00057
00058 rdin(:,:,1:nz)=rdinfull(:,:,1:nz)
00059 do i=1,nprocs-1
00060 temp(:,:,1:ends(i+1)-start(i+1)+5)=rdinfull(:,:,start(i+1)-2:ends(i+1)+2)
00061 call mpi_send(temp,nx*ny*nz_max,MPI_REAL,&
00062 & i,9,MPI_COMM_WORLD,ierr)
00063 enddo
00064 endif
00065 if(my_rank .ne. 0) then
00066 call mpi_recv(rdin,nx*ny*nz_max,MPI_REAL,&
00067 & 0,9,MPI_COMM_WORLD,istatus,ierr)
00068 endif
00069
00070 end subroutine rdistributeall
00071
