diff --git a/cdn/cdnval.F90 b/cdn/cdnval.F90 index 835dcafc9d2dfa41ed704db98923ec4e0d1bb9da..9dec79d3c1e87993eb2787d2f9e833598497e48f 100644 --- a/cdn/cdnval.F90 +++ b/cdn/cdnval.F90 @@ -73,7 +73,7 @@ CONTAINS USE m_Ekwritesl ! and write to file. USE m_abcrot2 USE m_doswrite - USE m_cdnread, ONLY : cdn_read0, cdn_read + USE m_eig66_io, ONLY : read_eig USE m_corespec, only : l_cs ! calculation of core spectra (EELS) USE m_corespec_io, only : corespec_init USE m_corespec_eval, only : corespec_gaunt,corespec_rme,corespec_dos,corespec_ddscs @@ -112,23 +112,20 @@ CONTAINS #ifdef CPP_MPI INCLUDE 'mpif.h' - LOGICAL :: mpi_flag, mpi_status #endif + ! .. Local Scalars .. - INTEGER :: llpd,ikpt,jsp_start,jsp_end,ispin,jsp - INTEGER :: i,ie,iv,ivac,j,k,l,n,ilo,isp,nbands,noccbd + INTEGER :: ikpt,jsp_start,jsp_end,ispin,jsp + INTEGER :: i,ie,ivac,j,k,l,n,ilo,nbands,noccbd INTEGER :: skip_t,skip_tt INTEGER :: nStart,nEnd,nbasfcn LOGICAL :: l_fmpl,l_evp,l_orbcomprot,l_real, l_write - ! ...Local Arrays .. - INTEGER :: noccbd_in(kpts%nkpt) - INTEGER :: nStart_in(kpts%nkpt) - INTEGER :: nEnd_in(kpts%nkpt) - REAL :: eig(dimension%neigd) + ! ...Local Arrays .. INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:) INTEGER, ALLOCATABLE :: jsym(:),ksym(:) REAL, ALLOCATABLE :: we(:) + REAL, ALLOCATABLE :: eig(:) REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions TYPE (t_lapw) :: lapw @@ -145,7 +142,6 @@ CONTAINS l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco) - llpd=(atoms%lmaxd*(atoms%lmaxd+3))/2 !---> l_fmpl is meant as a switch to to a plot of the full magnet. !---> density without the atomic sphere approximation for the magnet. !---> density. It is not completely implemented (lo's missing). @@ -223,18 +219,18 @@ CONTAINS skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype)) IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt ALLOCATE (we(MAXVAL(cdnvalKLoop%noccbd(:)))) + ALLOCATE (eig(MAXVAL(cdnvalKLoop%noccbd(:)))) jsp = MERGE(1,jspin,noco%l_noco) DO ikpt = cdnvalKLoop%ikptStart, cdnvalKLoop%nkptExtended, cdnvalKLoop%ikptIncrement + IF (ikpt.GT.kpts%nkpt) THEN #ifdef CPP_MPI - ! Synchronizes the RMA operations - CALL MPI_BARRIER(mpi%mpi_comm,ie) + CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations #endif EXIT END IF - ! -> Gu test: distribute ev's among the processors... CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi) skip_t = skip_tt noccbd = cdnvalKLoop%noccbd(ikpt) @@ -242,12 +238,8 @@ CONTAINS nEnd = cdnvalKLoop%nEnd(ikpt) we=0.0 - IF(noccbd.GT.0) THEN - we(1:noccbd) = results%w_iks(nStart:nEnd,ikpt,jsp) - END IF - IF ((sliceplot%slice).AND.(input%pallst)) THEN - we(:) = kpts%wtkpt(ikpt) - END IF + IF(noccbd.GT.0) we(1:noccbd) = results%w_iks(nStart:nEnd,ikpt,jsp) + IF ((sliceplot%slice).AND.(input%pallst)) we(:) = kpts%wtkpt(ikpt) IF (cdnvalKLoop%l_evp) THEN IF (nStart > skip_tt) skip_t = 0 @@ -257,20 +249,16 @@ CONTAINS nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco) CALL zMat%init(l_real,nbasfcn,noccbd) - CALL cdn_read(eig_id,dimension%nvd,dimension%jspd,mpi%irank,mpi%isize,& - ikpt,jspin,zmat%nbasfcn,noco%l_ss,noco%l_noco,& - noccbd,nStart,nEnd,nbands,eig,zMat) + CALL read_eig(eig_id,ikpt,jsp,n_start=nStart,n_end=nEnd,neig=nbands,zmat=zMat) #ifdef CPP_MPI - ! Synchronizes the RMA operations - CALL MPI_BARRIER(mpi%mpi_comm,ie) + CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations #endif eig(1:noccbd) = results%eig(nStart:nEnd,ikpt,jsp) IF (vacuum%nstm.EQ.3.AND.input%film) THEN - CALL nstm3(sym,atoms,vacuum,stars,ikpt,lapw%nv(jspin),input,jspin,kpts,& - cell,kpts%wtkpt(ikpt),lapw%k1(:,jspin),lapw%k2(:,jspin),& - enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),gvac1d,gvac2d) + CALL nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,& + cell,enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),gvac1d,gvac2d) END IF IF (noccbd.EQ.0) GO TO 199 @@ -386,14 +374,8 @@ CONTAINS !---> and write the information to the files dosinp and vacdos !---> for dos and bandstructure plots - !--dw parallel writing of vacdos,dosinp.... - ! write data to direct access file first, write to formated file later by PE 0 only! !--dw since z is no longer an argument of cdninf sympsi has to be called here! - - IF (banddos%ndir.GT.0) THEN - CALL sympsi(lapw%bkpt,lapw%nv(jspin),lapw%k1(:,jspin),lapw%k2(:,jspin),& - lapw%k3(:,jspin),sym,dimension,nbands,cell,eig,noco, ksym,jsym,zMat) - END IF + IF (banddos%ndir.GT.0) CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,ksym,jsym,zMat) CALL write_dos(eig_id,ikpt,jspin,regCharges,slab,orbcomp,ksym,jsym,mcd%mcd) @@ -404,7 +386,7 @@ CONTAINS #ifdef CPP_MPI CALL timestart("cdnval: mpi_col_den") DO ispin = jsp_start,jsp_end - CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,l_fmpl,ispin,llpd,regCharges,& + CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,l_fmpl,ispin,regCharges,& results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,:,jspin)) END DO CALL timestop("cdnval: mpi_col_den") @@ -412,8 +394,7 @@ CONTAINS IF (mpi%irank==0) THEN CALL cdnmt(dimension%jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end,& - enpara%el0,enpara%ello0,vTot%mt(:,0,:,:),denCoeffs,& - usdus,orb,denCoeffsOffdiag,moments,den%mt) + enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt) IF(l_cs) CALL corespec_ddscs(jspin,input%jspins) @@ -459,7 +440,7 @@ CONTAINS END IF ! end of (mpi%irank==0) #ifdef CPP_MPI - CALL MPI_BARRIER(mpi%mpi_comm,ie) + CALL MPI_BARRIER(mpi%mpi_comm,ie) ! Synchronizes the RMA operations #endif IF ((jsp_end.EQ.input%jspins)) THEN diff --git a/cdn_mt/cdnmt.f90 b/cdn_mt/cdnmt.f90 index 141ad231cbe26841e875b5f38f3ba416c5f73e15..ae8b5e59131d25cb4bbeff90067213546cf2b25f 100644 --- a/cdn_mt/cdnmt.f90 +++ b/cdn_mt/cdnmt.f90 @@ -10,8 +10,8 @@ MODULE m_cdnmt ! Philipp Kurz 2000-02-03 !*********************************************************************** CONTAINS - SUBROUTINE cdnmt(jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end, epar,& - ello,vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho) + SUBROUTINE cdnmt(jspd,atoms,sphhar,noco,l_fmpl,jsp_start,jsp_end,enpara,& + vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho) use m_constants,only: sfp_const USE m_rhosphnlo USE m_radfun @@ -23,6 +23,7 @@ CONTAINS TYPE(t_noco), INTENT(IN) :: noco TYPE(t_sphhar), INTENT(IN) :: sphhar TYPE(t_atoms), INTENT(IN) :: atoms + TYPE(t_enpara), INTENT(IN) :: enpara TYPE(t_moments), INTENT(INOUT) :: moments ! .. Scalar Arguments .. @@ -30,9 +31,7 @@ CONTAINS LOGICAL, INTENT (IN) :: l_fmpl ! .. ! .. Array Arguments .. - REAL, INTENT (IN) :: epar(0:atoms%lmaxd,atoms%ntype,jspd) REAL, INTENT (IN) :: vr(atoms%jmtd,atoms%ntype,jspd) - REAL, INTENT (IN) :: ello(atoms%nlod,atoms%ntype,jspd) REAL, INTENT (INOUT) :: rho(:,0:,:,:)!(toms%jmtd,0:sphhar%nlhd,atoms%ntype,jspd) TYPE (t_orb), INTENT(IN) :: orb TYPE (t_denCoeffs), INTENT(IN) :: denCoeffs @@ -66,7 +65,7 @@ CONTAINS !$OMP PARALLEL DEFAULT(none) & !$OMP SHARED(usdus,rho,moments,rho21,qmtl) & - !$OMP SHARED(atoms,jsp_start,jsp_end,epar,vr,denCoeffs,sphhar,ello)& + !$OMP SHARED(atoms,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)& !$OMP SHARED(orb,noco,l_fmpl,denCoeffsOffdiag,jspd)& !$OMP PRIVATE(itype,na,ispin,l,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs) IF (noco%l_mperp) THEN @@ -87,7 +86,7 @@ CONTAINS !---> spherical component DO ispin = jsp_start,jsp_end DO l = 0,atoms%lmax(itype) - CALL radfun(l,itype,ispin,epar(l,itype,ispin),vr(1,itype,ispin),atoms,& + CALL radfun(l,itype,ispin,enpara%el0(l,itype,ispin),vr(1,itype,ispin),atoms,& f(1,1,l,ispin),g(1,1,l,ispin),usdus, nodeu,noded,wronk) DO j = 1,atoms%jri(itype) s = denCoeffs%uu(l,itype,ispin)*( f(j,1,l,ispin)*f(j,1,l,ispin)+f(j,2,l,ispin)*f(j,2,l,ispin) )& @@ -106,7 +105,7 @@ CONTAINS CALL rhosphnlo(itype,atoms,sphhar,& usdus%uloulopn(1,1,itype,ispin),usdus%dulon(1,itype,ispin),& - usdus%uulon(1,itype,ispin),ello(1,itype,ispin),& + usdus%uulon(1,itype,ispin),enpara%ello0(1,itype,ispin),& vr(1,itype,ispin),denCoeffs%aclo(1,itype,ispin),denCoeffs%bclo(1,itype,ispin),& denCoeffs%cclo(1,1,itype,ispin),denCoeffs%acnmt(0,1,1,itype,ispin),& denCoeffs%bcnmt(0,1,1,itype,ispin),denCoeffs%ccnmt(1,1,1,itype,ispin),& diff --git a/dos/nstm3.f90 b/dos/nstm3.f90 index 7bed1e85b78d442a784cb76c630f644b72f1664d..273f1e13e65425ecf4a6bfdd46dd270fe19c1b0f 100644 --- a/dos/nstm3.f90 +++ b/dos/nstm3.f90 @@ -9,13 +9,9 @@ MODULE m_nstm3 ! !*********************************************************************** CONTAINS - SUBROUTINE nstm3(& - & sym,atoms,vacuum,stars,ikpt,nv,& - & input,jspin,kpts,& - & cell,wk,k1,k2,& - & evac,vz,& - & gvac1d,gvac2d) - ! + SUBROUTINE nstm3(sym,atoms,vacuum,stars,lapw,ikpt,input,jspin,kpts,& + cell,evac,vz,gvac1d,gvac2d) + USE m_sort USE m_types IMPLICIT NONE @@ -24,17 +20,16 @@ CONTAINS TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_sym),INTENT(IN) :: sym TYPE(t_stars),INTENT(IN) :: stars + TYPE(t_lapw),INTENT(IN) :: lapw TYPE(t_cell),INTENT(IN) :: cell TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_atoms),INTENT(IN) :: atoms ! .. ! .. Scalar Arguments .. - INTEGER, INTENT (IN) :: ikpt,nv + INTEGER, INTENT (IN) :: ikpt INTEGER, INTENT (IN) :: jspin - REAL, INTENT (IN) :: wk ! .. ! .. Array Arguments .. - INTEGER, INTENT (IN) :: k1(:),k2(:) REAL, INTENT (IN) :: evac(2) REAL, INTENT (IN) :: vz(:,:)!(vacuum%nmzd,2) INTEGER, INTENT (OUT) :: gvac1d(:),gvac2d(:) !(dimension%nv2d) @@ -50,17 +45,17 @@ CONTAINS ! IF (ikpt.EQ.1) THEN n2 = 0 - k_loop: DO k = 1,nv + k_loop: DO k = 1,lapw%nv(jspin) DO j = 1,n2 - IF (k1(k).EQ.gvac1(j).AND.k2(k).EQ.gvac2(j)) THEN + IF (lapw%k1(k,jspin).EQ.gvac1(j).AND.lapw%k2(k,jspin).EQ.gvac2(j)) THEN CYCLE k_loop END IF ENDDO n2 = n2 + 1 - gvac1(n2) = k1(k) - gvac2(n2) = k2(k) + gvac1(n2) = lapw%k1(k,jspin) + gvac2(n2) = lapw%k2(k,jspin) DO i=1,2 - gvac(i)=k1(k)*cell%bmat(1,i)+k2(k)*cell%bmat(2,i) + gvac(i)=lapw%k1(k,jspin)*cell%bmat(1,i)+lapw%k2(k,jspin)*cell%bmat(2,i) END DO gvacl(n2) = SQRT(REAL(gvac(1)**2+gvac(2)**2)) ENDDO k_loop @@ -120,7 +115,7 @@ CONTAINS ! only write here if not on T3E - WRITE (87,'(i3,1x,f12.6)') ikpt,wk + WRITE (87,'(i3,1x,f12.6)') ikpt,kpts%wtkpt(ikpt) END SUBROUTINE nstm3 END MODULE m_nstm3 diff --git a/dos/sympsi.F90 b/dos/sympsi.F90 index 1335f4a49d6864193c0e47d68d8a0c5565cc08b4..d87b7bf878bf00875a8e92426a38d7ea90872723 100644 --- a/dos/sympsi.F90 +++ b/dos/sympsi.F90 @@ -18,13 +18,14 @@ MODULE m_sympsi ! Jussi Enkovaara, Juelich 2004 CONTAINS - SUBROUTINE sympsi(bkpt,nv,kx,ky,kz,sym,DIMENSION,ne,cell,eig,noco, ksym,jsym,zMat) + SUBROUTINE sympsi(lapw,jspin,sym,DIMENSION,ne,cell,eig,noco, ksym,jsym,zMat) USE m_grp_k USE m_inv3 USE m_types IMPLICIT NONE + TYPE(t_lapw),INTENT(IN) :: lapw TYPE(t_dimension),INTENT(IN) :: DIMENSION TYPE(t_noco),INTENT(IN) :: noco TYPE(t_sym),INTENT(IN) :: sym @@ -32,11 +33,10 @@ CONTAINS TYPE(t_zMat),INTENT(IN) :: zMat ! ! .. Scalar Arguments .. - INTEGER, INTENT (IN) :: nv,ne + INTEGER, INTENT (IN) :: ne,jspin ! .. ! .. Array Arguments .. - INTEGER, INTENT (IN) :: kx(:),ky(:),kz(:)!(nvd) - REAL, INTENT (IN) :: bkpt(3),eig(DIMENSION%neigd) + REAL, INTENT (IN) :: eig(DIMENSION%neigd) INTEGER, INTENT (OUT):: jsym(DIMENSION%neigd),ksym(DIMENSION%neigd) ! .. @@ -72,9 +72,9 @@ CONTAINS IF (soc) THEN ALLOCATE(su(2,2,2*sym%nop)) - CALL grp_k(sym,mrot_k,cell,bkpt,nclass,nirr,c_table, grpname,irrname,su) + CALL grp_k(sym,mrot_k,cell,lapw%bkpt,nclass,nirr,c_table, grpname,irrname,su) ELSE - CALL grp_k(sym,mrot_k,cell,bkpt,nclass,nirr,c_table, grpname,irrname) + CALL grp_k(sym,mrot_k,cell,lapw%bkpt,nclass,nirr,c_table, grpname,irrname) ENDIF ALLOCATE(csum(ne,ne,nclass)) ALLOCATE(chars(ne,nclass)) @@ -97,25 +97,25 @@ CONTAINS gmap=0 DO c=1,nclass CALL inv3(mrot_k(:,:,c),mtmpinv,d) - kloop: DO k=1,nv - kv(1)=kx(k) - kv(2)=ky(k) - kv(3)=kz(k) - kv=kv+bkpt + kloop: DO k=1,lapw%nv(jspin) + kv(1)=lapw%k1(k,jspin) + kv(2)=lapw%k2(k,jspin) + kv(3)=lapw%k3(k,jspin) + kv=kv+lapw%bkpt kvtest=MATMUL(kv,mtmpinv) ! kvtest=MATMUL(kv,mrot_k(:,:,c)) - DO i = 1,nv - kv(1)=kx(i) - kv(2)=ky(i) - kv(3)=kz(i) - kv=kv+bkpt + DO i = 1,lapw%nv(jspin) + kv(1)=lapw%k1(i,jspin) + kv(2)=lapw%k2(i,jspin) + kv(3)=lapw%k3(i,jspin) + kv=kv+lapw%bkpt IF (ABS(kvtest(1)-kv(1)).LT.small.AND.& ABS(kvtest(2)-kv(2)).LT.small.AND. ABS(kvtest(3)-kv(3)).LT.small) THEN gmap(k,c)=i CYCLE kloop ENDIF ENDDO - WRITE(6,*) 'Problem in symcheck, cannot find rotated kv for', k,kx(k),ky(k),kz(k) + WRITE(6,*) 'Problem in symcheck, cannot find rotated kv for', k,lapw%k1(k,jspin),lapw%k2(k,jspin),lapw%k3(k,jspin) RETURN ENDDO kloop ENDDO @@ -124,16 +124,16 @@ CONTAINS DO i=1,ne norm(i)=0.0 IF (soc) THEN - DO k=1,nv*2 + DO k=1,lapw%nv(jspin)*2 norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2 ENDDO ELSE IF (zmat%l_real) THEN - DO k=1,nv + DO k=1,lapw%nv(jspin) norm(i)=norm(i)+ABS(zMat%z_r(k,i))**2 ENDDO ELSE - DO k=1,nv + DO k=1,lapw%nv(jspin) norm(i)=norm(i)+ABS(zMat%z_c(k,i))**2 ENDDO ENDIF @@ -161,21 +161,21 @@ CONTAINS DO n1=1,ndeg DO n2=1,ndeg IF (zmat%l_real) THEN - DO k=1,nv + DO k=1,lapw%nv(jspin) csum(n1,n2,c)=csum(n1,n2,c)+zMat%z_r(k,deg(n1))*& zMat%z_r(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2))) END DO ELSE IF (soc) THEN - DO k=1,nv + DO k=1,lapw%nv(jspin) csum(n1,n2,c)=csum(n1,n2,c)+(CONJG(zMat%z_c(k,deg(n1)))*& - (su(1,1,c)*zMat%z_c(gmap(k,c),deg(n2))+ su(1,2,c)*zMat%z_c(gmap(k,c)+nv,deg(n2)))+& - CONJG(zMat%z_c(k+nv,deg(n1)))* (su(2,1,c)*zMat%z_c(gmap(k,c),deg(n2))+& - su(2,2,c)*zMat%z_c(gmap(k,c)+nv,deg(n2))))/ (norm(deg(n1))*norm(deg(n2))) + (su(1,1,c)*zMat%z_c(gmap(k,c),deg(n2))+ su(1,2,c)*zMat%z_c(gmap(k,c)+lapw%nv(jspin),deg(n2)))+& + CONJG(zMat%z_c(k+lapw%nv(jspin),deg(n1)))* (su(2,1,c)*zMat%z_c(gmap(k,c),deg(n2))+& + su(2,2,c)*zMat%z_c(gmap(k,c)+lapw%nv(jspin),deg(n2))))/ (norm(deg(n1))*norm(deg(n2))) END DO ELSE - DO k=1,nv + DO k=1,lapw%nv(jspin) csum(n1,n2,c)=csum(n1,n2,c)+CONJG(zMat%z_c(k,deg(n1)))*& zMat%z_c(gmap(k,c),deg(n2))/(norm(deg(n1))*norm(deg(n2))) END DO @@ -217,7 +217,7 @@ CONTAINS !> IF (.NOT.char_written) THEN - WRITE(444,124) bkpt + WRITE(444,124) lapw%bkpt WRITE(444,*) 'Group is ' ,grpname DO c=1,nirr IF (zmat%l_real)THEN diff --git a/mpi/mpi_col_den.F90 b/mpi/mpi_col_den.F90 index 6b0a28abca88d7c208e43ce36882bd35e8efd762..65998d55190559616b6381db5133992cfbd01ebf 100644 --- a/mpi/mpi_col_den.F90 +++ b/mpi/mpi_col_den.F90 @@ -10,7 +10,7 @@ MODULE m_mpi_col_den ! CONTAINS SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,& - input, noco,l_fmpl,jspin,llpd,regCharges,& + input, noco,l_fmpl,jspin,regCharges,& results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp) #include"cpp_double.h" @@ -31,7 +31,7 @@ CONTAINS INCLUDE 'mpif.h' ! .. ! .. Scalar Arguments .. - INTEGER, INTENT (IN) :: jspin,llpd + INTEGER, INTENT (IN) :: jspin LOGICAL, INTENT (IN) :: l_fmpl ! .. ! .. Array Arguments .. @@ -104,7 +104,7 @@ CONTAINS ! !--> Collect uunmt,udnmt,dunmt,ddnmt ! - n = (llpd+1)*sphhar%nlhd*atoms%ntype + n = (((atoms%lmaxd*(atoms%lmaxd+3))/2)+1)*sphhar%nlhd*atoms%ntype ALLOCATE(r_b(n)) CALL MPI_REDUCE(denCoeffs%uunmt(0:,:,:,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr) IF (mpi%irank.EQ.0) THEN