00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027 program parallel_test1
00028
00029 implicit none
00030 include 'med.hf90'
00031 include 'mpif.h'
00032
00033 integer ret, fid
00034 integer USER_INTERLACE,USER_MODE
00035 integer*4 com,ioe,rank,nprocs
00036 integer info,com4_8
00037 integer nent
00038 integer nvent
00039 integer ncent
00040 integer start, stride, count, bsize, lbsize, resd
00041 character*64 :: pflname
00042 integer*8 flt(1)
00043 real*8, allocatable,dimension(:) :: val
00044 integer i,j,k
00045
00046 com4_8=MPI_COMM_WORLD
00047 info=MPI_INFO_NULL
00048
00049 call MPI_INIT(ioe)
00050 call MPI_COMM_SIZE(MPI_COMM_WORLD,nprocs,ioe)
00051 call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ioe)
00052
00053
00054 call mpfope(fid, 'NENT-942_NVAL-008_NCST-007.med', MED_ACC_RDONLY,com4_8, info, ret)
00055
00056 if (ret .ne. 0) then
00057 print *,"Erreur à l'ouverture du fichier"
00058 print *,"Process n° ",rank,"/",nprocs," ret :",ret
00059 call efexit(ret)
00060 endif
00061
00062 nent = 942
00063 nvent = 008
00064 ncent = 007
00065 pflname = ""
00066 bsize = nent/nprocs
00067
00068 lbsize = 0
00069 start = rank*(bsize)+1
00070 count = 1
00071 stride = bsize
00072 resd = 0
00073 if (rank.eq.(nprocs-1) ) then
00074 resd = nent-(nprocs*bsize)
00075 bsize = bsize + resd
00076 endif
00077 print *,"myrank :",rank," resd", resd," bsize ",bsize," lbsize",lbsize
00078
00079 call mfrall(1,flt,ret)
00080 if (ret .ne. 0) then
00081 print *,"Erreur à l'allocation du filtre"
00082 print *,"Process n° ",rank,"/",nprocs," ret :",ret
00083 call efexit(ret)
00084 endif
00085
00086 call mfrblc (fid, nent, nvent, ncent, &
00087 & MED_ALL_CONSTITUENT, MED_FULL_INTERLACE,MED_COMPACT_STMODE ,MED_ALLENTITIES_PROFILE, &
00088 & start, stride, count, bsize, lbsize, flt, ret)
00089
00090 if (ret .ne. 0) then
00091 print *,"Erreur à la définition du filtre"
00092 print *,"Process n° ",rank,"/",nprocs," ret :",ret
00093 call efexit(ret)
00094 endif
00095
00096 allocate(val(bsize*nvent*ncent),STAT=ret)
00097 val(:)=-1.1
00098
00099 call mfdrar ( fid, "NENT-942_NVAL-008_NCST-007_NBL-001",&
00100 & MED_NO_DT, MED_NO_IT, MED_CELL, MED_TRIA6,&
00101 & flt(1), val, ret )
00102 if (ret .ne. 0) then
00103 print *,"Erreur à la lecture du champ résultat"
00104 print *,"Process n° ",rank,"/",nprocs," ret :",ret
00105 call efexit(ret)
00106 endif
00107
00108 open(40+rank)
00109 do i=0,bsize-1
00110 do j=0,nvent-1
00111 do k=0,ncent-1
00112 write(40+rank,'(1X,F10.3,1X)',ADVANCE='NO') val(i*(ncent*nvent)+j*ncent+k+1)
00113 enddo
00114 write(40+rank,'(A)') "/"
00115 enddo
00116 write(40+rank,'(A)') "//"
00117 enddo
00118 close(40+rank)
00119
00120 deallocate(val)
00121
00122 call mfrdea(1,flt,ret)
00123 if (ret .ne. 0) then
00124 print *,"Erreur à la desallocation du filtre"
00125 print *,"Process n° ",rank,"/",nprocs," ret :",ret
00126 call efexit(ret)
00127 endif
00128
00129 print *,"Process n° ",rank,"/",nprocs," ret :",ret
00130
00131
00132
00133 call mficlo(fid,ret)
00134
00135 call MPI_FINALIZE(ioe)
00136
00137 end program parallel_test1