File: objarg_EmployeeArray_Impl.F90

package info (click to toggle)
babel 0.10.2-1
  • links: PTS
  • area: contrib
  • in suites: sarge
  • size: 43,932 kB
  • ctags: 29,707
  • sloc: java: 74,695; ansic: 73,142; cpp: 40,649; sh: 18,411; f90: 10,062; fortran: 6,727; python: 6,406; makefile: 3,866; xml: 118; perl: 48
file content (312 lines) | stat: -rw-r--r-- 10,581 bytes parent folder | download
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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
! 
! File:          objarg_EmployeeArray_Impl.F90
! Symbol:        objarg.EmployeeArray-v0.5
! Symbol Type:   class
! Babel Version: 0.10.2
! Description:   Server-side implementation for objarg.EmployeeArray
! 
! WARNING: Automatically generated; only changes within splicers preserved
! 
! babel-version = 0.10.2
! 


! 
! Symbol "objarg.EmployeeArray" (version 0.5)
! 
! This class manages a collection of employees.
! 


#include "objarg_EmployeeArray_fAbbrev.h"
#include "sidl_ClassInfo_fAbbrev.h"
#include "objarg_Employee_fAbbrev.h"
#include "sidl_BaseInterface_fAbbrev.h"
#include "sidl_BaseClass_fAbbrev.h"
! DO-NOT-DELETE splicer.begin(_miscellaneous_code_start)
! Insert extra code here...
! DO-NOT-DELETE splicer.end(_miscellaneous_code_start)




! 
! Class constructor called when the class is created.
! 

recursive subroutine objarg_EmployeeArray__ctor_mi(self)
  use objarg_EmployeeArray
  use objarg_EmployeeArray_impl
  ! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray._ctor.use)
  ! DO-NOT-DELETE splicer.end(objarg.EmployeeArray._ctor.use)
  implicit none
  type(objarg_EmployeeArray_t) :: self ! in

! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray._ctor)
  type(objarg_EmployeeArray_wrap) :: pd
  allocate(pd%d_private_data)
  pd%d_private_data%d_capacity = 0
  pd%d_private_data%d_length = 0
  pd%d_private_data%d_allocated = .false.
  call objarg_EmployeeArray__set_data_m(self, pd)
! DO-NOT-DELETE splicer.end(objarg.EmployeeArray._ctor)
end subroutine objarg_EmployeeArray__ctor_mi


! 
! Class destructor called when the class is deleted.
! 

recursive subroutine objarg_EmployeeArray__dtor_mi(self)
  use objarg_EmployeeArray
  use objarg_EmployeeArray_impl
  ! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray._dtor.use)
  ! DO-NOT-DELETE splicer.end(objarg.EmployeeArray._dtor.use)
  implicit none
  type(objarg_EmployeeArray_t) :: self ! in

! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray._dtor)
  type(objarg_EmployeeArray_wrap) :: pd
  type(objarg_Employee_t)         :: employee
  integer(selected_int_kind(9))   :: i
  call objarg_EmployeeArray__get_data_m(self, pd)
  do i = 1, pd%d_private_data%d_length
     employee = pd%d_private_data%d_employees(i)
     call set_null(pd%d_private_data%d_employees(i))
     call deleteRef(employee)
  end do
  if (pd%d_private_data%d_allocated) then
     deallocate(pd%d_private_data%d_employees)
     pd%d_private_data%d_allocated = .false.
  endif
  deallocate(pd%d_private_data)
! DO-NOT-DELETE splicer.end(objarg.EmployeeArray._dtor)
end subroutine objarg_EmployeeArray__dtor_mi


! 
! Static class initializer called exactly once before any user-defined method is dispatched
! 

recursive subroutine objarg_EmployeeArray__load_mi()
  use objarg_EmployeeArray
  use objarg_EmployeeArray_impl
  ! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray._load.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(objarg.EmployeeArray._load.use)
  implicit none

! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray._load)
! Insert the implementation here...
! DO-NOT-DELETE splicer.end(objarg.EmployeeArray._load)
end subroutine objarg_EmployeeArray__load_mi


! 
! Return the number of employees in the employee array.
! 

recursive subroutine Employee_getLengthf1kxbf743e_mi(self, retval)
  use objarg_EmployeeArray
  use objarg_EmployeeArray_impl
  ! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.getLength.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.getLength.use)
  implicit none
  type(objarg_EmployeeArray_t) :: self ! in
  integer (selected_int_kind(9)) :: retval ! out

! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.getLength)
  type(objarg_EmployeeArray_wrap) :: pd
  call objarg_EmployeeArray__get_data_m(self, pd)
  retval = pd%d_private_data%d_length
! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.getLength)
end subroutine Employee_getLengthf1kxbf743e_mi


! 
! Return the employee in position <code>index</code> where
! <code>index</code> ranges from 1 to the length of the array.
! If <code>index</code> is outside the range of the array (i.e.
! less than or equal to zero or greater than the current number
! of elements in the array), this method returns a NULL
! employee object.
! 

recursive subroutine objarg_EmployeeArray_at_mi(self, index, retval)
  use objarg_EmployeeArray
  use objarg_Employee
  use objarg_EmployeeArray_impl
  ! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.at.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.at.use)
  implicit none
  type(objarg_EmployeeArray_t) :: self ! in
  integer (selected_int_kind(9)) :: index ! in
  type(objarg_Employee_t) :: retval ! out

! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.at)
  type(objarg_EmployeeArray_wrap) :: pd
  type(objarg_Employee_t) :: employee
  call objarg_EmployeeArray__get_data_m(self, pd)
  if ((index .gt. 0) .and. &
       (index .le. pd%d_private_data%d_length)) then
     retval = pd%d_private_data%d_employees(index)
     call addRef(retval)
  else
     call set_null(retval)
  end if
! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.at)
end subroutine objarg_EmployeeArray_at_mi


! 
! Add an employee onto the end of the array.  It is perfectly
! legal to add the same employee multiple times.
! <code>true</code> is returned when the append was successful;
! otherwise, <code>false</code> is returned to indicate
! failure.  This method will not add a NULL employee.
! 

recursive subroutine Emp_appendEmployeey1p0il489c_mi(self, e, retval)
  use objarg_EmployeeArray
  use objarg_Employee
  use objarg_EmployeeArray_impl
  ! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.appendEmployee.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.appendEmployee.use)
  implicit none
  type(objarg_EmployeeArray_t) :: self ! in
  type(objarg_Employee_t) :: e ! in
  logical :: retval ! out

! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.appendEmployee)
  type (objarg_EmployeeArray_wrap) :: pd
  type (objarg_Employee_t), dimension(:), pointer :: newarray
  integer(selected_int_kind(9)) :: newcapacity, i
  if (not_null(e)) then
     call objarg_EmployeeArray__get_data_m(self, pd)
     if (pd%d_private_data%d_length .ge. pd%d_private_data%d_capacity) then
        newcapacity = pd%d_private_data%d_capacity + 4
        if ((pd%d_private_data%d_capacity / 10) .gt. 4) then
           newcapacity = pd%d_private_data%d_capacity + &
                pd%d_private_data%d_capacity / 10
        endif
        allocate(newarray(newcapacity))
        do i = 1, pd%d_private_data%d_length
           newarray(i) = pd%d_private_data%d_employees(i)
        end do
        if (pd%d_private_data%d_allocated) then
           deallocate(pd%d_private_data%d_employees)
        endif
        pd%d_private_data%d_employees => newarray
        pd%d_private_data%d_allocated = .true.
        pd%d_private_data%d_capacity = newcapacity
     end if
     call addRef(e)
     pd%d_private_data%d_length = pd%d_private_data%d_length + 1
     pd%d_private_data%d_employees(pd%d_private_data%d_length) = e
     retval = .true.
  else
     retval = .false.
  endif
! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.appendEmployee)
end subroutine Emp_appendEmployeey1p0il489c_mi


! 
! Find the first employee in the array that has a name matching
! <code>name</code>.  If a match exists, the index is returned,
! and the employee is returned in parameter <code>e</code>.
! 
! If no match exists, 0 is returned, and <code>e</code> is NULL.
! 

recursive subroutine Employe_findByNameshr253wixu_mi(self, name, e, retval)
  use objarg_EmployeeArray
  use objarg_Employee
  use objarg_EmployeeArray_impl
  ! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.findByName.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.findByName.use)
  implicit none
  type(objarg_EmployeeArray_t) :: self ! in
  character (len=*) :: name ! in
  type(objarg_Employee_t) :: e ! out
  integer (selected_int_kind(9)) :: retval ! out

! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.findByName)
  character(len=256) :: lname, tname
  integer(selected_int_kind(9)) :: i
  type(objarg_EmployeeArray_wrap) :: pd
  type(objarg_Employee_t) :: tmp
  call objarg_EmployeeArray__get_data_m(self, pd)
  lname = name
  retval = 0
  do i = 1, pd%d_private_data%d_length
     tmp = pd%d_private_data%d_employees(i)
     if (not_null(tmp)) then
        call getName(tmp, tname)
        if (lname .eq. tname) then
           retval = i
           e = tmp
           call addRef(tmp)
           return
        endif
     endif
  end do
! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.findByName)
end subroutine Employe_findByNameshr253wixu_mi


! 
! Determine the maximum salary in the array. If the maximum
! salary in the array is greater than the current salary of
! <code>e</code>, the salary of <code>e</code> will be 
! increased to the maximum salary in the array.  If the
! array is empty, no change will be made to <code>e</code>.
! 
! This method returns <code>true</code> iff the salary of
! <code>e</code> is modified.
! 

recursive subroutine promoteToMaxSalaryvyx713pe07_mi(self, e, retval)
  use objarg_EmployeeArray
  use objarg_Employee
  use objarg_EmployeeArray_impl
  ! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.promoteToMaxSalary.use)
  ! Insert use statements here...
  ! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.promoteToMaxSalary.use)
  implicit none
  type(objarg_EmployeeArray_t) :: self ! in
  type(objarg_Employee_t) :: e ! inout
  logical :: retval ! out

! DO-NOT-DELETE splicer.begin(objarg.EmployeeArray.promoteToMaxSalary)
  integer(selected_int_kind(9)) :: i
  type(objarg_EmployeeArray_wrap) :: pd
  type(objarg_Employee_t) :: tmp
  real(selected_real_kind(6,37)) :: maxsalary, salary
  retval = .false.
  if (not_null(e)) then
     call objarg_EmployeeArray__get_data_m(self, pd)
     maxsalary = -1.0e30
     do i = 1, pd%d_private_data%d_length
        call getSalary(pd%d_private_data%d_employees(i), salary)
        if (salary .gt. maxSalary) then
           maxsalary = salary
        endif
     end do
     call getSalary(e, salary)
     if (maxSalary .gt. salary) then
        call setSalary(e, maxSalary)
        retval = .true.
     endif
  endif
! DO-NOT-DELETE splicer.end(objarg.EmployeeArray.promoteToMaxSalary)
end subroutine promoteToMaxSalaryvyx713pe07_mi


! DO-NOT-DELETE splicer.begin(_miscellaneous_code_end)
! Insert extra code here...
! DO-NOT-DELETE splicer.end(_miscellaneous_code_end)