-
Notifications
You must be signed in to change notification settings - Fork 4
/
m_parse_blkdat.F90
141 lines (109 loc) · 3.23 KB
/
m_parse_blkdat.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
module m_parse_blkdat
private :: blkini, blkinr, blkinvoid
contains
subroutine parse_blkdat(cvar,vtype,realvar,intvar,blkfilein,imatch)
implicit none
character(len=6), intent(in) :: cvar
character(len=*), intent(in) :: vtype
integer, intent(out) :: intvar
real , intent(out) :: realvar
character(len=*), intent(in), optional :: blkfilein
integer , intent(in), optional :: imatch
character(len=80) :: blkfile
logical :: found,ex
integer :: nmatch,imatch2
if (present(blkfilein)) then
blkfile=blkfilein
else
blkfile='blkdat.input'
end if
if (present(imatch)) then
imatch2=imatch
else
imatch2=1
end if
inquire(exist=ex,file=trim(blkfile))
nmatch=0
if (ex) then
open(99,file=trim(blkfile),status='old')
! Skip header
read(99,*)
read(99,*)
read(99,*)
read(99,*)
found=.false.
do while (.not.found)
found = blkinvoid(cvar)
if (found) then
nmatch=nmatch+1
!print *,found,nmatch,imatch2
found=found.and.nmatch==imatch2
!print *,found
end if
end do
! if found, read..
if (found) then
backspace(99)
if (trim(vtype)=='integer') then
call blkini(intvar,cvar)
elseif (trim(vtype)=='real') then
call blkinr(realvar,cvar,'(a6," =",f10.4," m")')
else
print *,'Dont know how to handle variable type '//trim(vtype)
stop '(parse_blkdat)'
end if
else
print *,'Cant find varable'
stop '(parse_blkdat)'
end if
close(99)
else
print *,'Cant find '//trim(blkfile)
stop '(parse_blkdat)'
end if
end subroutine parse_blkdat
subroutine blkinr(rvar,cvar,cfmt)
!use mod_xc ! HYCOM communication interface
implicit none
real rvar
character cvar*6,cfmt*(*)
! read in one real value
character*6 cvarin
read(99,*) rvar,cvarin
write(6,cfmt) cvarin,rvar
!call flush(6)
if (cvar.ne.cvarin) then
write(6,*)
write(6,*) 'error in blkinr - input ',cvarin, &
' but should be ',cvar
write(6,*)
!call flush(6)
stop '(blkinr)'
endif
return
end subroutine
subroutine blkini(ivar,cvar)
implicit none
integer ivar
character*6 cvar
! read in one integer value
character*6 cvarin
read(99,*) ivar,cvarin
if (cvar.ne.cvarin) then
write(6,*)
write(6,*) 'error in blkini - input ',cvarin, &
' but should be ',cvar
write(6,*)
!call flush(6)
stop '(blkini)'
endif
end subroutine blkini
logical function blkinvoid(cvar)
implicit none
real :: rvar
character :: cvar*6
character*6 :: cvarin
read(99,*) rvar, cvarin
blkinvoid = trim(cvar) == trim(cvarin)
end function blkinvoid
end module m_parse_blkdat