-
Notifications
You must be signed in to change notification settings - Fork 2
/
ems_p.f
34 lines (32 loc) · 1004 Bytes
/
ems_p.f
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
C->>> -----------------------------------------------> ems_g_emsol_p <<<
c Get the EMSOL pointers
c
subroutine ems_g_emsol_p(rt_cod, is)
implicit none
integer rt_cod, is(0:*)
c print*, 'Calling TRUE ems_g_emsol_p'
call ems_g_ml_p(rt_cod, is)
if (rt_cod .ne. 0) goto 7000
call ems_g_rsmi_p(rt_cod, is)
if (rt_cod .ne. 0) goto 7000
call ems_g_inv_p(rt_cod, is)
if (rt_cod .ne. 0) goto 7000
7000 continue
return
end
C->>> -----------------------------------------> ems_se_emsol_p_no_p <<<
c Get the EMSOL pointers
c
subroutine ems_se_emsol_p_no_p(rt_cod, is)
implicit none
integer rt_cod, is(0:*)
c print*, 'Calling TRUE ems_se_emsol_p_no_p'
call ems_se_ml_p_no_p(rt_cod, is)
if (rt_cod .ne. 0) goto 7000
call ems_se_rsmi_p_no_p(rt_cod)
if (rt_cod .ne. 0) goto 7000
call ems_se_inv_p_no_p(rt_cod)
if (rt_cod .ne. 0) goto 7000
7000 continue
return
end