The ABINIT Users Mailing List ( CLOSED )

[Mauro Sgroi <maurosgroi@yahoo.it>]

Dear Matthieu,
Thanks a lot for the help and the kindness.
My best regards,
Mauro.

--- Matthieu Verstraete <mjv500@york.ac.uk> ha
scritto:

> 
> Hello Mauro and co.
> 
> the fortran format was insufficient for your
> numbers. I'm surprised this 
> hasn't happened before. Anyhow I have modified the
> source and committed to 
> 5.4.3, which should appear soon.
> 
> For the impatient, use the attached cut3d.F90
> 
> Matthieu
> 
> -- 
>
================================================================
> Dr. Matthieu Verstraete                
> mailto:mjv500@york.ac.uk
> Dept. of Physics, University of York,     tel: +44
> 1904 43 22 08
> Heslington, YO10 5DD York, United Kingdom fax: +44
> 1904 43 22 14> !{\src2tex{textfont=tt}}
> !!****p* ABINIT/cut3d
> !! NAME
> !! cut3d
> !!
> !! FUNCTION
> !! Main routine for the analysis of the density and
> potential files,
> !! as well as other files with the ABINIT header.
> !!
> !! COPYRIGHT
> !! Copyright (C) 1999-2007 ABINIT group (GMR, RC,
> LSI, XG, NCJ, JFB, MCote, LPizzagalli)
> !! This file is distributed under the terms of the
> !! GNU General Public License, see ~abinit/COPYING
> !! or http://www.gnu.org/copyleft/gpl.txt .
> !! For the initials of contributors, see
> ~abinit/doc/developers/contributors.txt .
> !!
> !! INPUTS
> !!  (main program)
> !!
> !! OUTPUT
> !!  (main program)
> !!
> !! PARENTS
> !!
> !! CHILDREN
> !!     
>
date_and_time,handle_ncerr,hdr_clean,hdr_io,herald,hirsh,lineint
> !!     
>
localorb_s,planeint,pointint,rrho,rtau,volumeint,wffile
> !!
> !! SOURCE
> 
> #if defined HAVE_CONFIG_H
> #include "config.h"
> #endif
> 
> program cut3d
> 
>  use defs_basis
> #if defined FC_NAG
>  use f90_unix
> #endif
> #if defined HAVE_NETCDF
>  use netcdf
> #endif
>  use defs_datatypes
>  use defs_infos
> 
> !This section has been created automatically by the
> script Abilint (TD). Do not modify these by hand.
> #ifdef HAVE_FORTRAN_INTERFACES
>  use interfaces_01manage_mpi
>  use interfaces_13io_mpi
>  use interfaces_14iowfdenpot
>  use interfaces_19cut3d
> #else
>  use defs_interfaces
> #endif
> !End of the abilint section
> 
>  implicit none
> 
> !Arguments -----------------------------------
> 
> !Local variables-------------------------------
>   ! natom = number of atoms in the unit cell
>   ! nr1,nr2,nr3 = grid size (nr1 x nr2 x nr3 =
> filrho dimension)
>   ! ntypat = number of atom types
>   ! ucvol = unit cell volume (> 0)
>   ! densfileformat = flag for the format of the
> density file:
>   !         0 = ASCII
>   !         1 = binary
>   ! denval = density value exported by interpol, to
> be wrote in the output file
>   ! filrho = name of the density file (ASCII or
> binary)
>   ! filtau = name of the atomic position file (Xmol
> format)
>   ! acell = unit cell parameters
>   ! rprim = orientation of the unit cell axes
>   character(len=*), parameter :: INPUTfile='cut.in'
>   !For NetCDF
>
*******************************************************
> #if defined HAVE_NETCDF
>   character(len=3), parameter ::
>
monnam(12)=(/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'/)
> #endif
> !scalars
>  integer ::
>
atomicnumVarID,atomposiVarID,dataVarID,dd,densfileformat,exchn2n3
>  integer ::
>
fform0,grid1VarID,grid2VarID,grid3VarID,gridshift1,gridshift2
>  integer ::
>
gridshift3,gridsize1DimID,gridsize2DimID,gridsize3DimID,i1,i2,i3
>  integer ::
>
iatom,igrid,ii,ii1,ii2,ii3,index,iprompt,ir1,ir2,ir3,ispden,itask
>  integer ::
>
latDimID,latticevecVarID,mm,natom,nbatomDimID,ncid,nr1,nr2,nr3
>  integer ::
>
nspden,ntypat,originVarID,posDimID,rdwr,status,titlechoice,unitfi
>  integer :: yyyy
>  real(dp) :: denval,ucvol
>  real*4 :: xm,xnow,xp,ym,ynow,yp,zm,znow,zp
>  logical :: filexist
>  character(1) :: outputchar
>  character(len=10) :: strtime
>  character(len=11) :: stridate
>  character(len=24) :: codename
>  character(len=5) :: strzone
>  character(len=50) :: chr_inputfname
>  character(len=500) :: filetitle
>  character(len=8) :: strdat
>  character(len=fnlen) :: filnam,filrho,filtau
>  type(hdr_type) :: hdr
> !arrays
>  integer :: values(8)
>  real(dp) ::
>
acell(3),gridwavefun1(3,2),gridwavefun2(3,2),gridwavefun3(3,2)
>  real(dp) ::
>
originatt(3,3),rprim(3,3),rprimd(3,3),shift_tau(3),value(2)
>  real(dp) :: xcart2(3)
>  real(dp),allocatable ::
> grid(:,:,:),grid_full(:,:,:,:),nuclz(:),tau2(:,:)
> !DEBUG (LD)
>  real(dp),allocatable ::
>
gridtt(:,:,:),gridux(:,:,:),griddy(:,:,:),gridmz(:,:,:)
> !ENDDEBUG (LD)
>  real(dp),allocatable :: xcart(:,:),xred(:,:)
>  real*4,allocatable :: rhomacu(:,:)
> 
>
!******************************************************************
> !BEGIN EXECUTABLE SECTION
> 
>  codename='CUT3D '//repeat(' ',18)
>  call herald(codename,abinit_version,std_out)
> 
> !Get name of density file
>  write(*,*)
>  write(*,*) ' What is the name of the 3D function
> (density, potential or wavef) file ?'
>  read(5,*)filrho
>  write(*,*) ' => Your 3D function file is :
> ',trim(filrho)
>  write(*,*)
> 
> !Checking the existence of data file
>  inquire (file=filrho,exist=filexist)
>  if (.NOT. filexist) then
>   write(*,*) 'Error, missing data file: ',filrho
>   stop
>  end if
> 
> !Get its type
>  write(*,*) ' Does this file contain formatted 3D
> ASCII data (=0)  '
>  write(*,*) '  or unformatted binary header + 3D
> data        (=1) ?'
>  read(5,*)densfileformat
> 
> !Treat the different cases : formatted or
> unformatted
>  if(densfileformat==1)then
> 
>   write(*,*) ' 1 => Your file contains unformatted
> binary header + 3D data'
>   write(*,*) ' The information it contains should be
> sufficient.'
> 
>  
>
open(unit=19,file=filrho,form='unformatted',status='old')
>   write(6, '(a,a,a,i4)' )&
> &  '  cut3d : read file ',trim(filrho),' from unit
> number 19.'
>   write(*,*)
> 
> ! Read the header
>   rdwr=1 ; unitfi=19
>   call hdr_io(fform0,hdr,rdwr,unitfi)
> 
> ! Echo part of the header
>   rdwr=4 ; unitfi=6
>   call hdr_io(fform0,hdr,rdwr,unitfi)
> 
>   natom=hdr%natom
>   nr1=hdr%ngfft(1)
>   nr2=hdr%ngfft(2)
>   nr3=hdr%ngfft(3)
>   nspden=hdr%nspden
>   ntypat=hdr%ntypat
>   rprimd(:,:)=hdr%rprimd(:,:)
> 
> ! Need to know natom in order to allocate xcart
>   allocate(xcart(3,natom),xred(3,natom))
>   xred(:,:)=hdr%xred(:,:)
>   do iatom=1,natom
>    xcart(:,iatom)=rprimd(:,1)*xred(1,iatom)+&
> 
=== message truncated ===



      ___________________________________ 
L'email della prossima generazione? Puoi averla con la nuova Yahoo! Mail: 
http://it.docs.yahoo.com/nowyoucan.html