38
39
40
46
47
48
49#include "implicit_f.inc"
50
51
52
53#include "com04_c.inc"
54#include "sphcom.inc"
55#include "scr17_c.inc"
56#include "r2r_c.inc"
57
58
59
60 INTEGER SVSPHIO
61 INTEGER NOM_OPT(LNOPT1,*)
62 TYPE (SURF_), DIMENSION(NSURF) :: IGRSURF
63 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
64
65
66
67 INTEGER I, J, N, ID, IDS, NSEG, ITYPE, IDSURF, SKIP, LVAD
68 CHARACTER(LEN=NCHARTITLE) :: TITR
69 LOGICAL IS_AVAILABLE
70
71 svsphio = 0
72 is_available = .false.
73
74
76
77
78 i = 0
79 DO n = 1,nsphio
80 skip = 0
81
82 IF (nsubdom > 0) THEN
84 ENDIF
85
86 IF (skip == 0) THEN
87 i = i+1
88
89
90 titr = ''
93 . option_titr = titr)
95 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
96
97
98 CALL hm_get_intv(
'Itype' ,itype ,is_available,lsubmodel)
99 CALL hm_get_intv(
'SURF_ID' ,idsurf ,is_available,lsubmodel)
100
101 IF ((idsurf > 0).AND.(itype == 1)) THEN
102 ids=0
103 DO j=1,nsurf
104 IF(igrsurf(j)%ID == idsurf) THEN
105 ids=j
106 EXIT
107 ENDIF
108 ENDDO
109 nseg = igrsurf(ids)%NSEG
110 lvad = 4 + 2*nseg
111 ELSE
112 lvad = 22
113 ENDIF
114 svsphio = svsphio + lvad
115 ENDIF
116 ENDDO
117
118
119 RETURN
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_start(entity_type)
integer, parameter nchartitle
integer, dimension(:), allocatable tagsphio