New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
m_pseudo_types.f90 in vendors/XMLF90/current/doc/Examples/xpath – NEMO

source: vendors/XMLF90/current/doc/Examples/xpath/m_pseudo_types.f90 @ 1960

Last change on this file since 1960 was 1960, checked in by flavoni, 14 years ago

importing XMLF90 r_53 vendor

File size: 2.8 KB
Line 
1module m_pseudo_types
2!
3! Data structures for a prototype pseudopotential
4!
5integer, parameter, private    :: MAXN_POTS = 8
6integer, parameter, private    :: dp = selected_real_kind(14)
7!
8public  :: dump_pseudo
9!
10!-----------------------------------------------------------
11type, public :: grid_t
12!
13!     It should be possible to represent both log and linear
14!     grids with a few parameters here.
15!
16      character(len=20)              :: type
17      real(kind=dp)                  :: scale
18      real(kind=dp)                  :: step 
19      integer                        :: npts 
20end type grid_t     
21!
22type, public :: radfunc_t
23      type(grid_t)                            :: grid
24      real(kind=dp), dimension(:), pointer    :: data
25end type radfunc_t     
26     
27type, public :: vps_t
28      integer                        :: l
29      integer                        :: n
30      integer                        :: spin
31      real(kind=dp)                  :: occupation
32      real(kind=dp)                  :: cutoff
33      type(radfunc_t)                :: V
34end type vps_t
35
36type, public :: header_t
37        character(len=2)        :: symbol
38        real(kind=dp)           :: zval
39        character(len=10)       :: creator
40        character(len=10)       :: date
41        character(len=40)       :: flavor
42        logical                 :: relativistic
43        logical                 :: polarized
44        character(len=2)        :: correlation
45        character(len=4)        :: core_corrections
46end type header_t
47
48type, public :: pseudo_t
49      type(header_t)                     :: header
50      integer                            :: npots 
51      integer                            :: npots_down
52      integer                            :: npots_up 
53      type(vps_t), dimension(MAXN_POTS)  :: pot
54      type(radfunc_t)                    :: core_charge
55      type(radfunc_t)                    :: valence_charge
56end type pseudo_t
57
58
59CONTAINS !===============================================
60
61subroutine dump_pseudo(pseudo)
62type(pseudo_t), intent(in), target   :: pseudo
63
64integer  :: i
65type(vps_t), pointer :: pp
66type(radfunc_t), pointer :: rp
67
68print *, "---PSEUDO data:"
69
70do i = 1, pseudo%npots
71      pp =>  pseudo%pot(i)
72      rp =>  pseudo%pot(i)%V
73      print *, "VPS ", i, " angular momentum: ", pp%l
74      print *, "                 n: ", pp%n
75      print *, "                 occupation: ", pp%occupation
76      print *, "                 cutoff: ", pp%cutoff
77      print *, "                 spin: ", pp%spin
78      print *, "grid data: ", rp%grid%npts, rp%grid%scale
79enddo
80rp => pseudo%valence_charge
81print *, "grid data: ", rp%grid%npts, rp%grid%scale
82rp => pseudo%core_charge
83print *, "grid data: ", rp%grid%npts, rp%grid%scale
84
85end subroutine dump_pseudo
86
87end module m_pseudo_types
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Note: See TracBrowser for help on using the repository browser.