← Back to branch summary

~jose-soler/siesta/unfolding

« back to all changes in this revision

Viewing changes to Pseudo/atom/Util/cdf2vps.f

  • Committer: Alberto Garcia
  • Date: 2016-01-25 16:00:16 UTC
  • mto: (483.3.1 rel-4.0)
  • mto: This revision was merged to the branch mainline in revision 485.
  • Revision ID: albertog@icmab.es-20160125160016-c1qivg1zw06kgyfd
Prepare GPL release

* Include proper headers

* Add Docs/Contributors.txt and NOTICE.txt files.

* Update READMEs and LICENSE files in several directories.

* Remove Pseudo/atom, Util/test-xml

* Remove DOM files from Src/xmlparser

Show diffs side-by-side

added added

removed removed

Lines of Context:
Pseudo/atom/Util/cdf2vps.f
1
 
c
2
 
      program cdf2vps
3
 
c
4
 
      use netcdf
5
 
 
6
 
      implicit none
7
 
c
8
 
c     This program converts pseudopotential netCDF files to "VPS" 
9
 
c     format.
10
 
c
11
 
      integer ncid, iret
12
 
      integer nrp_id, n_up_id, n_down_id
13
 
      integer r_id, v_up_id, v_down_id, l_up_id, l_down_id
14
 
      integer core_id, val_id
15
 
      integer ptr
16
 
c
17
 
      double precision a, b, zion
18
 
      character*2 nameat, corr
19
 
      character*3 rel
20
 
      character*4 core
21
 
      character*10 ray(6), title(7)
22
 
c
23
 
      character*70 title_str
24
 
      character*60 ray_str
25
 
c
26
 
      integer i, j, lo, nrp, npotd, npotu
27
 
      double precision, allocatable  :: v(:)
28
 
c
29
 
      integer iargc, nargs
30
 
      character*70 cdf_file, binary_file
31
 
c
32
 
c     Let's get the files from the command line:
33
 
c
34
 
      nargs = iargc()
35
 
      if (nargs .ne. 2) then
36
 
         write(0,*) 'Usage: cdf2vps netCDF_file vps_file'
37
 
         stop 
38
 
      endif
39
 
c
40
 
      call getarg(1,cdf_file)
41
 
      call getarg(2,binary_file)
42
 
c
43
 
c      open files
44
 
c
45
 
      iret = nf90_open(cdf_file,NF90_NOWRITE,ncid)
46
 
      open(unit=2,file=binary_file,form='unformatted',status='replace')
47
 
c
48
 
      title_str = ' '
49
 
      ray_str = ' '
50
 
      iret = nf90_get_att(ncid,nf90_global,'Element',nameat)
51
 
      iret = nf90_get_att(ncid,nf90_global,'Title',ray_str)
52
 
      iret = nf90_get_att(ncid,nf90_global,'Config',title_str)
53
 
      iret = nf90_get_att(ncid,nf90_global,'Correlation',corr)
54
 
      iret = nf90_get_att(ncid,nf90_global,'Relativistic',rel)
55
 
      iret = nf90_get_att(ncid,nf90_global,'Core',core)
56
 
      iret = nf90_get_att(ncid,nf90_global,'Valence_charge',zion)
57
 
      iret = nf90_get_att(ncid,nf90_global,'a_parameter',a)
58
 
      iret = nf90_get_att(ncid,nf90_global,'b_parameter',b)
59
 
c
60
 
      do i=1,7
61
 
         ptr = (i-1)*10 + 1
62
 
         title(i) = title_str(ptr:ptr+9)
63
 
      enddo
64
 
      do i=1,6
65
 
         ptr = (i-1)*10 + 1
66
 
         ray(i) = ray_str(ptr:ptr+9)
67
 
      enddo
68
 
 
69
 
      iret = nf90_inq_dimid(ncid,'nrp',nrp_id)
70
 
      iret = nf90_inquire_dimension(ncid,nrp_id,len=nrp)
71
 
 
72
 
      iret =  nf90_inq_dimid(ncid,'n_down',n_down_id)
73
 
      iret = nf90_inquire_dimension(ncid,n_down_id,len=npotd)
74
 
 
75
 
      iret =  nf90_inq_dimid(ncid,'n_up',n_up_id)
76
 
      if (iret .ne. nf90_noerr) then
77
 
         write(0,'(a)') 'No up potentials'
78
 
         npotu = 0
79
 
      else
80
 
         iret = nf90_inquire_dimension(ncid,n_up_id,len=npotu)
81
 
      endif
82
 
 
83
 
      write(2) nameat, corr, rel, core, (ray(j),j=1,6), 
84
 
     &         (title(j),j=1,7), npotd, npotu, nrp, a, b, zion
85
 
 
86
 
      allocate(v(nrp))
87
 
 
88
 
      iret = nf90_inq_varid(ncid,'l_down',l_down_id)
89
 
      iret = nf90_inq_varid(ncid,'v_down',v_down_id)
90
 
      if (npotu .ne. 0) then
91
 
         iret = nf90_inq_varid(ncid,'l_up',l_up_id)
92
 
         iret = nf90_inq_varid(ncid,'v_up',v_up_id)
93
 
      endif
94
 
c
95
 
      iret = nf90_inq_varid(ncid,'r',r_id)
96
 
      iret = nf90_inq_varid(ncid,'core_charge',core_id)
97
 
      iret = nf90_inq_varid(ncid,'val_charge',val_id)
98
 
c
99
 
      iret = nf90_get_var(ncid,r_id,v(1:nrp))
100
 
      write(2) (v(j),j=1,nrp)
101
 
c 
102
 
c     "Down" potentials
103
 
c
104
 
      do 30 i = 1, npotd
105
 
         iret = nf90_get_var(ncid,l_down_id,lo,start=(/i/))
106
 
         iret = nf90_get_var(ncid,v_down_id,v(1:nrp),start=(/i,1/),
107
 
     $                       count=(/1,nrp/))
108
 
         write(2) lo, (v(j),j=1,nrp)
109
 
   30 continue
110
 
c
111
 
c     "Up" potentials
112
 
c
113
 
      do i = 1, npotu
114
 
         iret = nf90_get_var(ncid,l_up_id,lo,start=(/i/))
115
 
         iret = nf90_get_var(ncid,v_up_id,v(1:nrp),start=(/i,1/),
116
 
     $                       count=(/1,nrp/))
117
 
         write(2) lo, (v(j),j=1,nrp)
118
 
      enddo
119
 
c
120
 
c     Core and valence charge
121
 
c
122
 
      iret = nf90_get_var(ncid,core_id,v(1:nrp))
123
 
      write(2) (v(j),j=1,nrp)
124
 
      iret = nf90_get_var(ncid,val_id,v(1:nrp))
125
 
      write(2) (v(j),j=1,nrp)
126
 
c
127
 
      iret= nf90_close(ncid)
128
 
 
129
 
      contains
130
 
 
131
 
      subroutine check(status)
132
 
      
133
 
      integer, intent(in):: status
134
 
      if (status .ne. nf90_noerr) then
135
 
         print  *, trim(nf90_strerror(status))
136
 
         stop 'Stopped'
137
 
      endif
138
 
      end subroutine check
139
 
 
140
 
      end program cdf2vps
141
 
 
142
 
 
143
 
 
144
 
 
145
 
 
146