libsim  Versione7.2.1
modqc_peel_util_include.F90
1 
3 elemental logical function vd/**/vol7d_poly_types (flag)
4 
5 /**/vol7d_poly_type ,intent(in) :: flag
6 
7 
8 vd/**/vol7d_poly_types = .not. (realdat(flag,vol7d_var_new(qcattrvarsbtables(2),scalefactor=0)) <= qcpar%att .and. c_e(flag)&
9  .and. c_e(qcpar%att))
10 
11 
12 return
13 end function vd/**/vol7d_poly_types
14 
15 
17 elemental logical function vdge/**/vol7d_poly_types (flag)
18 
19 /**/vol7d_poly_type ,intent(in) :: flag
20 
21 
22 vdge/**/vol7d_poly_types = .not. (realdat(flag,vol7d_var_new(qcattrvarsbtables(2),scalefactor=0)) == qcpar%gross_error .and. c_e(flag) &
23  .and. c_e(qcpar%gross_error))
24 
25 
26 return
27 end function vdge/**/vol7d_poly_types
28 
29 
31 elemental logical function invalidated/**/vol7d_poly_types(flag)
32 
33 /**/vol7d_poly_type ,intent(in) :: flag
34 
35 invalidated/**/vol7d_poly_types= realdat(flag,vol7d_var_new(qcattrvarsbtables(1),scalefactor=0)) == qcpar%invalidated .and. c_e(flag) &
36  .and. c_e(qcpar%invalidated)
37 
38 
39 return
40 end function invalidated/**/vol7d_poly_types
41 
48 
61 
62 ELEMENTAL LOGICAL FUNCTION qcsummaryflag/**/vol7d_poly_types(flag0, flag1, flag2, flag3)
63 /**/vol7d_poly_type ,intent(in),optional :: flag0
64 /**/vol7d_poly_type ,intent(in),optional :: flag1
65 /**/vol7d_poly_type ,intent(in),optional :: flag2
66 /**/vol7d_poly_type ,intent(in),optional :: flag3
67 integer :: tot
68 
69 
70 #ifdef VOL7D_POLY_ISC
71 
72 if (invalidated(optio_3/**/vol7d_poly_types(flag0))) then
73  qcsummaryflag/**/vol7d_poly_types = .false.
74  return
75 endif
76 
77 if ( .not. vdge(optio_3/**/vol7d_poly_types(flag1))) then
78  qcsummaryflag/**/vol7d_poly_types = .false.
79  return
80 endif
81 
82 tot=0
83 
84 if (.not. vd(optio_3/**/vol7d_poly_types(flag1))) then
85  tot = tot -1
86 endif
87 
88 if (.not. vd(optio_3/**/vol7d_poly_types(flag2))) then
89  tot = tot -1
90 endif
91 if (vd(optio_3/**/vol7d_poly_types(flag2)) .and. c_e(optio_3/**/vol7d_poly_types(flag2))) then
92  tot = tot +1
93 endif
94 
95 if (.not. vd(optio_3/**/vol7d_poly_types(flag3))) then
96  tot = tot -1
97 endif
98 if (vd(optio_3/**/vol7d_poly_types(flag3)) .and. c_e(optio_3/**/vol7d_poly_types(flag3))) then
99  tot = tot +1
100 endif
101 
102 qcsummaryflag/**/vol7d_poly_types=(tot >= -1)
103 
104 contains
105 
108 elemental function optio_3c(var) result(char)
109 
110 character (len=*),intent(in),optional :: var
111 !here the string len needed is 3 but so is more easy
112 /**/vol7d_poly_type :: char
113 
114 if (present(var))then
115  char=var
116 else
117  char=cmiss
118 end if
119 
120 return
121 end function optio_3c
122 
123 #else
124 
125 
126 if (invalidated(optio_/**/vol7d_poly_types(flag0))) then
127  qcsummaryflag/**/vol7d_poly_types = .false.
128  return
129 endif
130 
131 if ( .not. vdge(optio_/**/vol7d_poly_types(flag1))) then
132  qcsummaryflag/**/vol7d_poly_types = .false.
133  return
134 endif
135 
136 tot=0
137 
138 if (.not. vd(optio_/**/vol7d_poly_types(flag1))) then
139  tot = tot -1
140 endif
141 
142 if (.not. vd(optio_/**/vol7d_poly_types(flag2))) then
143  tot = tot -1
144 endif
145 if (vd(optio_/**/vol7d_poly_types(flag2)) .and. c_e(optio_/**/vol7d_poly_types(flag2))) then
146  tot = tot +1
147 endif
148 
149 if (.not. vd(optio_/**/vol7d_poly_types(flag3))) then
150  tot = tot -1
151 endif
152 if (vd(optio_/**/vol7d_poly_types(flag3)) .and. c_e(optio_/**/vol7d_poly_types(flag3))) then
153  tot = tot +1
154 endif
155 
156 qcsummaryflag/**/vol7d_poly_types=(tot >= -1)
157 
158 #endif
159 
160 
161 END FUNCTION qcsummaryflag/**/vol7d_poly_types
162 

Generated with Doxygen.