-
Notifications
You must be signed in to change notification settings - Fork 0
/
test.f90
148 lines (129 loc) · 5.11 KB
/
test.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
program test_io_params
use ioparams, only: group1_t, group2_t
use ioparams, only: read_nml, write_nml, read_nml_file
use ioparams, only: set_param, get_param
use ioparams, only: parse_command_args, print_help, join_array
use ioparams, only: command_argument_as_array
use ioparams, only: has_param, set_param_string ! low-level
implicit none
type(group1_t) :: group1
type(group2_t) :: group2
character(len=256) :: filename, filename2
integer :: iounit = 88
double precision :: test_dp
logical :: test_l
integer :: test_int, test_int_arr(7)
character(len=50) :: test_s
character(len=50) :: args(14)
character(len=50), allocatable :: unmatched(:)
integer :: i, parsed, io, iostat, iostats(2), stat
character(len=256) :: arg, argv
filename = "namelist.nml"
write(*,*) " "
write(*,*) "++++++++++++++++++++++++++++++++++++"
write(*,*) "Testing nml2f90.py"
write(*,*) "++++++++++++++++++++++++++++++++++++"
write(*,*) " "
write(*,*) "Test reading namelist"
write(*,*) "---------------------"
! Read parameters from file
write(*,*) "READ from ",trim(filename)
open(iounit, file=filename, status="OLD")
write(*,*) "...group1...(read_nml)"
call read_nml(iounit, group1)
close(iounit)
write(*,*) "...group2...(read_nml_file)"
call read_nml_file(filename, group2)
write(*,*) "Done. Namelist read successfully."
write(*,*) " "
write(*,*) "Test set_param / get_param "
write(*,*) "---------------------------"
call get_param(group2, "string1", test_s)
call set_param(group2, 'string1', "this is a new string set via set_param")
write(*,*) "group2%string1:", trim(test_s), " ==> ", trim(group2%string1), " (this is ...)"
call get_param(group2, "double1", test_dp)
call set_param(group2, 'double1', 11111111111.11111111111d0)
write(*,*) "group2%double1:", test_dp, " ==> ", group2%double1, " (111...)"
call get_param(group2, 'integer1', test_int)
call set_param(group2, 'integer1', 777777777)
write(*,*) "group2%integer1:", test_int, " ==> ", group2%integer1, " (777..)"
call get_param(group2, "intarr1", test_int_arr)
call set_param(group2, "intarr1", [7,6,5,4,3,2,1])
write(*,*) "group2%intarr1:", test_int_arr, " ==> ", group2%intarr1, " (7,6,5...)"
call get_param(group2, "logical1", test_l)
call set_param(group2, "logical1", .false.)
write(*,*) "group2%longical1:", test_l, " ==> ", group2%logical1, " (false)"
write(*,*) " "
write(*,*) "Test has_param"
write(*,*) "--------------"
write(*,*) "has_param(group1, 'integer1') ? ", has_param(group1, 'integer1')
write(*,*) "has_param(group1, 'thisdoesnotexists') ? ", has_param(group1, 'thisdoesnotexists')
write(*,*)
write(*,*) "Test set_param_string"
write(*,*) "---------------------"
call set_param_string(group2, 'string1', "another string")
call set_param_string(group2, 'double1', "3333.44444")
call set_param_string(group2, 'integer1', "3333")
call set_param_string(group2, "intarr1", "(/ 7,7,7,7,7,7,7 /)")
call set_param_string(group2, "logical1", ".true.")
write(*,*)
write(*,*) "Test command-line arguments passed as string array"
write(*,*) "--------------------------------------------------"
args(1) = "--string1"
args(2) = "newtext.txt"
args(3) = "--logical1"
args(4) = "F"
args(5) = "--integer1"
args(6) = "2"
args(7) = "--double1"
args(8) = "777"
args(9) = "--stringarr1"
args(10) = "bb,cc,dd"
args(11) = "--intarr1"
args(12) = "1, 2, 3, 4, 5, 6, 7"
args(13) = "--dblarr1"
args(14) = "5.,4,3,2,1"
call parse_command_args(group1, stop_on_help=.false., args=args, unmatched=unmatched)
call parse_command_args(group2, args=unmatched) !, unmatched=unmatched)
call assert_cmd("group1%string1", "newtext.txt"== group1%string1)
call assert_cmd("group1%logical1", .false. .eqv. group1%logical1)
call assert_cmd("group1%integer1", 2== group1%integer1)
call assert_cmd("group2%double1", 777.d0== group2%double1)
call assert_cmd("group1%stringarr1(2)", "cc"== group1%stringarr1(2))
call assert_cmd("group2%intarr1(3)", 3== group2%intarr1(3))
call assert_cmd("group2%dblarr1(1)", 5.d0== group2%dblarr1(1))
!
! Retrieve command-line arguments
!
write(*,*) " "
write(*,*) "Test command line parameters "
write(*,*) "----------------------------- "
write(*,*) "Type ./test.x -h for help on how to do that."
i = 1
io=0
parsed = 0
call command_argument_as_array(unmatched)
call parse_command_args(group1, args=unmatched, unmatched=unmatched, stop_on_help=.false.)
call parse_command_args(group2, args=unmatched, unmatched=unmatched)
if (size(unmatched) > 0) then
write(*,*) "Invalid parameters: ", trim(join_array(unmatched))
stop
endif
! Print namelist to screen
write(*,*) " "
write(*,*) "Test writing to namelist_check.nml "
open(88, file="namelist_check.nml", action="WRITE")
call write_nml(88, group1)
call write_nml(88, group2)
close(88)
write(*,*) "Done. All tests terminated successfully"
contains
subroutine assert_cmd(nm, test)
character(len=*), intent(in) :: nm
logical, intent(in) :: test
if (.not.test) then
write(*,*) "ERROR: failed cmd",nm
stop
endif
end subroutine
end program