Skip to content

Commit 4c76ff8

Browse files
wpbonelliwpbonelli
committed
simplify ExchangeFactory
1 parent 4621306 commit 4c76ff8

File tree

1 file changed

+61
-265
lines changed

1 file changed

+61
-265
lines changed

‎src/ExchangeFactory.f90

Lines changed: 61 additions & 265 deletions
Original file line numberDiff line numberDiff line change
@@ -1,254 +1,28 @@
11
module ExchangeFactoryModule
22
use KindModule, only: I4B, LGP
3-
use ConstantsModule, only: LENMEMPATH, LINELENGTH, LENEXCHANGENAME
4-
use SimModule, only: store_error, count_errors
5-
use SimVariablesModule, only: iout, idm_context, model_names, model_loc_idx
6-
use MemoryHelperModule, only: create_mem_path
7-
use MemoryManagerModule, only: mem_setptr, mem_allocate
3+
use ConstantsModule, only: LENMEMPATH, LINELENGTH
4+
use SimModule, only: store_error
5+
use SimVariablesModule, only: iout, model_names, model_loc_idx
86
use CharacterStringModule, only: CharacterStringType
97
use ArrayHandlersModule, only: ifind
8+
use GwfGwfExchangeModule, only: gwfgwf_cr
9+
use GwfGwtExchangeModule, only: gwfgwt_cr
10+
use GwfGweExchangeModule, only: gwfgwe_cr
11+
use GwfPrtExchangeModule, only: gwfprt_cr
12+
use GwtGwtExchangeModule, only: gwtgwt_cr
13+
use GweGweExchangeModule, only: gwegwe_cr
14+
use SwfGwfExchangeModule, only: swfgwf_cr
15+
use VirtualGwfExchangeModule, only: add_virtual_gwf_exchange
16+
use VirtualGwtExchangeModule, only: add_virtual_gwt_exchange
17+
use VirtualGweExchangeModule, only: add_virtual_gwe_exchange
18+
use VirtualPrtExchangeModule, only: add_virtual_prt_exchange
1019

1120
implicit none
1221
private
1322
public :: create_exchanges
1423

1524
contains
1625

17-
subroutine create_gwfgwf_exchange( &
18-
fname, &
19-
exg_id, &
20-
both_local, &
21-
both_remote, &
22-
m1_id, m2_id, &
23-
exg_mempath)
24-
! -- modules
25-
use GwfGwfExchangeModule, only: gwfgwf_cr
26-
use VirtualGwfExchangeModule, only: add_virtual_gwf_exchange
27-
! -- dummy
28-
character(len=LINELENGTH), intent(in) :: fname
29-
integer(I4B), intent(in) :: exg_id
30-
logical(LGP), intent(in) :: both_local
31-
logical(LGP), intent(in) :: both_remote
32-
integer(I4B), intent(in) :: m1_id
33-
integer(I4B), intent(in) :: m2_id
34-
character(len=LENMEMPATH), intent(in) :: exg_mempath
35-
! -- local
36-
character(len=LENEXCHANGENAME) :: exg_name
37-
38-
write (exg_name, '(a,i0)') 'GWF-GWF_', exg_id
39-
if (.not. both_remote) &
40-
call gwfgwf_cr( &
41-
fname, &
42-
exg_name, &
43-
exg_id, &
44-
m1_id, &
45-
m2_id, &
46-
exg_mempath)
47-
call add_virtual_gwf_exchange( &
48-
exg_name, &
49-
exg_id, &
50-
m1_id, &
51-
m2_id)
52-
end subroutine create_gwfgwf_exchange
53-
54-
subroutine create_gwfgwt_exchange( &
55-
fname, &
56-
exg_id, &
57-
both_local, &
58-
both_remote, &
59-
m1_id, m2_id, &
60-
exg_mempath)
61-
! -- modules
62-
use GwfGwtExchangeModule, only: gwfgwt_cr
63-
! -- dummy
64-
character(len=LINELENGTH), intent(in) :: fname
65-
integer(I4B), intent(in) :: exg_id
66-
logical(LGP), intent(in) :: both_local
67-
logical(LGP), intent(in) :: both_remote
68-
integer(I4B), intent(in) :: m1_id
69-
integer(I4B), intent(in) :: m2_id
70-
character(len=LENMEMPATH), intent(in) :: exg_mempath
71-
! -- local
72-
character(len=LENEXCHANGENAME) :: exg_name
73-
74-
write (exg_name, '(a,i0)') 'GWF-GWT_', exg_id
75-
if (both_local) &
76-
call gwfgwt_cr( &
77-
fname, &
78-
exg_name, &
79-
exg_id, &
80-
m1_id, &
81-
m2_id, &
82-
exg_mempath)
83-
end subroutine create_gwfgwt_exchange
84-
85-
subroutine create_gwtgwt_exchange( &
86-
fname, &
87-
exg_id, &
88-
both_local, &
89-
both_remote, &
90-
m1_id, m2_id, &
91-
exg_mempath)
92-
! -- modules
93-
use GwtGwtExchangeModule, only: gwtgwt_cr
94-
use VirtualGwtExchangeModule, only: add_virtual_gwt_exchange
95-
! -- dummy
96-
character(len=LINELENGTH), intent(in) :: fname
97-
integer(I4B), intent(in) :: exg_id
98-
logical(LGP), intent(in) :: both_local
99-
logical(LGP), intent(in) :: both_remote
100-
integer(I4B), intent(in) :: m1_id
101-
integer(I4B), intent(in) :: m2_id
102-
character(len=LENMEMPATH), intent(in) :: exg_mempath
103-
! -- local
104-
character(len=LENEXCHANGENAME) :: exg_name
105-
106-
write (exg_name, '(a,i0)') 'GWT-GWT_', exg_id
107-
if (.not. both_remote) &
108-
call gwtgwt_cr( &
109-
fname, &
110-
exg_name, &
111-
exg_id, &
112-
m1_id, &
113-
m2_id, &
114-
exg_mempath)
115-
call add_virtual_gwt_exchange( &
116-
exg_name, &
117-
exg_id, &
118-
m1_id, &
119-
m2_id)
120-
end subroutine create_gwtgwt_exchange
121-
122-
subroutine create_gwfgwe_exchange( &
123-
fname, &
124-
exg_id, &
125-
both_local, &
126-
both_remote, &
127-
m1_id, m2_id, &
128-
exg_mempath)
129-
! -- modules
130-
use GwfGweExchangeModule, only: gwfgwe_cr
131-
! -- dummy
132-
character(len=LINELENGTH), intent(in) :: fname
133-
integer(I4B), intent(in) :: exg_id
134-
logical(LGP), intent(in) :: both_local
135-
logical(LGP), intent(in) :: both_remote
136-
integer(I4B), intent(in) :: m1_id
137-
integer(I4B), intent(in) :: m2_id
138-
character(len=LENMEMPATH), intent(in) :: exg_mempath
139-
! -- local
140-
character(len=LENEXCHANGENAME) :: exg_name
141-
142-
write (exg_name, '(a,i0)') 'GWF-GWE_', exg_id
143-
if (.not. both_remote) &
144-
call gwfgwe_cr( &
145-
fname, &
146-
exg_name, &
147-
exg_id, &
148-
m1_id, &
149-
m2_id, &
150-
exg_mempath)
151-
end subroutine create_gwfgwe_exchange
152-
153-
subroutine create_gwegwe_exchange( &
154-
fname, &
155-
exg_id, &
156-
both_local, &
157-
both_remote, &
158-
m1_id, m2_id, &
159-
exg_mempath)
160-
! -- modules
161-
use GweGweExchangeModule, only: gwegwe_cr
162-
use VirtualGweExchangeModule, only: add_virtual_gwe_exchange
163-
! -- dummy
164-
character(len=LINELENGTH), intent(in) :: fname
165-
integer(I4B), intent(in) :: exg_id
166-
logical(LGP), intent(in) :: both_local
167-
logical(LGP), intent(in) :: both_remote
168-
integer(I4B), intent(in) :: m1_id
169-
integer(I4B), intent(in) :: m2_id
170-
character(len=LENMEMPATH), intent(in) :: exg_mempath
171-
! -- local
172-
character(len=LENEXCHANGENAME) :: exg_name
173-
174-
write (exg_name, '(a,i0)') 'GWE-GWE_', exg_id
175-
if (.not. both_remote) &
176-
call gwegwe_cr( &
177-
fname, &
178-
exg_name, &
179-
exg_id, &
180-
m1_id, &
181-
m2_id, &
182-
exg_mempath)
183-
call add_virtual_gwe_exchange( &
184-
exg_name, &
185-
exg_id, &
186-
m1_id, &
187-
m2_id)
188-
end subroutine create_gwegwe_exchange
189-
190-
subroutine create_gwfprt_exchange( &
191-
fname, &
192-
exg_id, &
193-
both_local, &
194-
both_remote, &
195-
m1_id, m2_id, &
196-
exg_mempath)
197-
! -- modules
198-
use GwfPrtExchangeModule, only: gwfprt_cr
199-
! -- dummy
200-
character(len=LINELENGTH), intent(in) :: fname
201-
integer(I4B), intent(in) :: exg_id
202-
logical(LGP), intent(in) :: both_local
203-
logical(LGP), intent(in) :: both_remote
204-
integer(I4B), intent(in) :: m1_id
205-
integer(I4B), intent(in) :: m2_id
206-
character(len=LENMEMPATH), intent(in) :: exg_mempath
207-
! -- local
208-
character(len=LENEXCHANGENAME) :: exg_name
209-
210-
write (exg_name, '(a,i0)') 'GWF-PRT_', exg_id
211-
if (.not. both_remote) &
212-
call gwfprt_cr( &
213-
fname, &
214-
exg_name, &
215-
exg_id, &
216-
m1_id, &
217-
m2_id, &
218-
exg_mempath)
219-
end subroutine create_gwfprt_exchange
220-
221-
subroutine create_swfgwf_exchange( &
222-
fname, &
223-
exg_id, &
224-
both_local, &
225-
both_remote, &
226-
m1_id, m2_id, &
227-
exg_mempath)
228-
! -- modules
229-
use SwfGwfExchangeModule, only: swfgwf_cr
230-
! -- dummy
231-
character(len=LINELENGTH), intent(in) :: fname
232-
integer(I4B), intent(in) :: exg_id
233-
logical(LGP), intent(in) :: both_local
234-
logical(LGP), intent(in) :: both_remote
235-
integer(I4B), intent(in) :: m1_id
236-
integer(I4B), intent(in) :: m2_id
237-
character(len=LENMEMPATH), intent(in) :: exg_mempath
238-
! -- local
239-
character(len=LENEXCHANGENAME) :: exg_name
240-
241-
write (exg_name, '(a,i0)') 'SWF-GWF_', exg_id
242-
if (.not. both_remote) &
243-
call swfgwf_cr( &
244-
fname, &
245-
exg_name, &
246-
exg_id, &
247-
m1_id, &
248-
m2_id, &
249-
exg_mempath)
250-
end subroutine create_swfgwf_exchange
251-
25226
subroutine create_exchanges(etypes, efiles, emnames_a, emnames_b, emempaths)
25327
! -- dummy
25428
type(CharacterStringType), dimension(:), contiguous, &
@@ -265,7 +39,7 @@ subroutine create_exchanges(etypes, efiles, emnames_a, emnames_b, emempaths)
26539
integer(I4B) :: exg_id, n
26640
integer(I4B) :: m1_id, m2_id
26741
logical(LGP) :: both_remote, both_local
268-
character(len=LINELENGTH) :: fname, name1, name2
42+
character(len=LINELENGTH) :: fname, name1, name2, exg_name
26943
character(len=LENMEMPATH) :: exg_mempath
27044
character(len=LINELENGTH) :: errmsg, exgtype
27145
! -- formats
@@ -305,65 +79,87 @@ subroutine create_exchanges(etypes, efiles, emnames_a, emnames_b, emempaths)
30579

30680
select case (exgtype)
30781
case ('GWF6-GWF6')
308-
call create_gwfgwf_exchange( &
82+
write (exg_name, '(a,i0)') 'GWF-GWF_', exg_id
83+
if (.not. both_remote) &
84+
call gwfgwf_cr( &
30985
fname, &
86+
exg_name, &
31087
exg_id, &
311-
both_local, &
312-
both_remote, &
31388
m1_id, &
31489
m2_id, &
31590
exg_mempath)
316-
case ('GWF6-GWT6')
317-
call create_gwfgwt_exchange( &
91+
call add_virtual_gwf_exchange( &
92+
exg_name, &
93+
exg_id, &
94+
m1_id, &
95+
m2_id)
96+
case ('GWT6-GWT6')
97+
write (exg_name, '(a,i0)') 'GWT-GWT_', exg_id
98+
if (.not. both_remote) &
99+
call gwtgwt_cr( &
318100
fname, &
101+
exg_name, &
319102
exg_id, &
320-
both_local, &
321-
both_remote, &
322103
m1_id, &
323104
m2_id, &
324105
exg_mempath)
325-
case ('GWT6-GWT6')
326-
call create_gwtgwt_exchange( &
106+
call add_virtual_gwt_exchange( &
107+
exg_name, &
108+
exg_id, &
109+
m1_id, &
110+
m2_id)
111+
case ('GWE6-GWE6')
112+
write (exg_name, '(a,i0)') 'GWE-GWE_', exg_id
113+
if (.not. both_remote) &
114+
call gwegwe_cr( &
327115
fname, &
116+
exg_name, &
328117
exg_id, &
329-
both_local, &
330-
both_remote, &
331118
m1_id, &
332119
m2_id, &
333120
exg_mempath)
334-
case ('GWE6-GWE6')
335-
call create_gwegwe_exchange( &
121+
call add_virtual_gwe_exchange( &
122+
exg_name, &
123+
exg_id, &
124+
m1_id, &
125+
m2_id)
126+
case ('GWF6-GWT6')
127+
write (exg_name, '(a,i0)') 'GWF-GWT_', exg_id
128+
if (both_local) &
129+
call gwfgwt_cr( &
336130
fname, &
131+
exg_name, &
337132
exg_id, &
338-
both_local, &
339-
both_remote, &
340133
m1_id, &
341134
m2_id, &
342135
exg_mempath)
343136
case ('GWF6-GWE6')
344-
call create_gwfgwe_exchange( &
137+
write (exg_name, '(a,i0)') 'GWF-GWE_', exg_id
138+
if (both_local) &
139+
call gwfgwe_cr( &
345140
fname, &
141+
exg_name, &
346142
exg_id, &
347-
both_local, &
348-
both_remote, &
349143
m1_id, &
350144
m2_id, &
351145
exg_mempath)
352146
case ('GWF6-PRT6')
353-
call create_gwfprt_exchange( &
147+
write (exg_name, '(a,i0)') 'GWF-PRT_', exg_id
148+
if (both_local) &
149+
call gwfprt_cr( &
354150
fname, &
151+
exg_name, &
355152
exg_id, &
356-
both_local, &
357-
both_remote, &
358153
m1_id, &
359154
m2_id, &
360155
exg_mempath)
361156
case ('SWF6-GWF6')
362-
call create_swfgwf_exchange( &
157+
write (exg_name, '(a,i0)') 'SWF-GWF_', exg_id
158+
if (both_local) &
159+
call swfgwf_cr( &
363160
fname, &
161+
exg_name, &
364162
exg_id, &
365-
both_local, &
366-
both_remote, &
367163
m1_id, &
368164
m2_id, &
369165
exg_mempath)

0 commit comments

Comments
 (0)