1 /* CalculiX - A 3-dimensional finite element program */
2 /* Copyright (C) 1998-2021 Guido Dhondt */
3
4 /* This program is free software; you can redistribute it and/or */
5 /* modify it under the terms of the GNU General Public License as */
6 /* published by the Free Software Foundation(version 2); */
7 /* */
8
9 /* This program is distributed in the hope that it will be useful, */
10 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
11 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
12 /* GNU General Public License for more details. */
13
14 /* You should have received a copy of the GNU General Public License */
15 /* along with this program; if not, write to the Free Software */
16 /* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
17
18 #include <stdlib.h>
19 #include <math.h>
20 #include <stdio.h>
21 #include <string.h>
22 #include "CalculiX.h"
23
frdset(char * filabl,char * set,ITG * iset,ITG * istartset,ITG * iendset,ITG * ialset,ITG * inum,ITG * noutloc,ITG * nout,ITG * nset,ITG * noutmin,ITG * noutplus,ITG * iselect,ITG * ngraph)24 void frdset(char *filabl,char *set,ITG *iset,ITG *istartset,ITG *iendset,
25 ITG *ialset,ITG *inum,ITG *noutloc,ITG *nout,ITG *nset,
26 ITG *noutmin,ITG *noutplus,ITG *iselect,ITG *ngraph){
27
28 ITG j,k;
29
30 char noset[81];
31
32 /* check for a set, if any */
33
34 strcpy1(noset,&filabl[6],81);
35 for((*iset)=0;(*iset)<(*nset);(*iset)++){
36 if(strcmp2(&set[81**iset],noset,81)==0) break;
37 }
38 (*iset)++;
39 if(*iset>*nset)*iset=0;
40 // printf("iset,noutplus %" ITGFORMAT " %" ITGFORMAT "\n",*iset,*noutplus);
41
42 /* determining the number of nodes in the set */
43
44 if(*iset==0){
45
46 /* no set defined */
47
48 // printf("iselect,noutplus %" ITGFORMAT " %" ITGFORMAT "\n",*iselect,*noutplus);
49
50 if(*iselect==1){
51 *noutloc=*noutplus;
52 }else if(*iselect==-1){
53 *noutloc=*noutmin;
54 }else{
55 *noutloc=*nout;
56 }
57
58 }else{
59
60 /* a set was defined */
61
62 *noutloc=0;
63 for(j=istartset[*iset-1]-1;j<iendset[*iset-1];j++){
64 if(ialset[j]>0){
65 if(*iselect==-1){
66 if(inum[ialset[j]-1]<0) (*noutloc)++;
67 }else if(*iselect==1){
68 if(inum[ialset[j]-1]>0) (*noutloc)++;
69 }else{
70 if(inum[ialset[j]-1]!=0) (*noutloc)++;
71 }
72 }else{
73 k=ialset[j-2];
74 do{
75 k=k-ialset[j];
76 if(k>=ialset[j-1]) break;
77 if(*iselect==-1){
78 if(inum[k-1]<0) (*noutloc)++;
79 }else if(*iselect==1){
80 if(inum[k-1]>0) (*noutloc)++;
81 }else{
82 if(inum[k-1]!=0) (*noutloc)++;
83 }
84 }while(1);
85 }
86 }
87 if(*ngraph>1) (*noutloc)*=(*ngraph);
88 }
89
90
91 }
92
93
94 /*!
95 ! CalculiX - A 3-dimensional finite element program
96 ! Copyright (C) 1998-2021 Guido Dhondt
97 !
98 ! This program is free software; you can redistribute it and/or
99 ! modify it under the terms of the GNU General Public License as
100 ! published by the Free Software Foundation(version 2);
101 !
102 !
103 ! This program is distributed in the hope that it will be useful,
104 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
105 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
106 ! GNU General Public License for more details.
107 !
108 ! You should have received a copy of the GNU General Public License
109 ! along with this program; if not, write to the Free Software
110 ! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
111 !
112 subroutine frdset(filabl,set,iset,istartset,iendset,
113 & ialset,inum,noutloc,nout,nset,noutmin,noutplus,iselect,
114 & ngraph)
115 !
116 ! stores the results in frd format
117 !
118 implicit none
119 !
120 character*81 set(*),noset
121 character*87 filabl
122 !
123 integer iset,istartset(*),iendset(*),ialset(*),inum(*),
124 & noutloc,j,k,nout,nset,noutmin,noutplus,iselect,ngraph
125 !
126 ! check for a set, if any
127 !
128 noset=filabl(7:87)
129 do iset=1,nset
130 if(set(iset).eq.noset) exit
131 enddo
132 if(iset.gt.nset) iset=0
133 !
134 ! determining the number of nodes in the set
135 !
136 if(iset.eq.0) then
137 if(iselect.eq.1) then
138 noutloc=noutplus
139 elseif(iselect.eq.-1) then
140 noutloc=noutmin
141 else
142 noutloc=nout
143 endif
144 else
145 noutloc=0
146 do j=istartset(iset),iendset(iset)
147 if(ialset(j).gt.0) then
148 if(iselect.eq.-1) then
149 if(inum(ialset(j)).lt.0) noutloc=noutloc+1
150 elseif(iselect.eq.1) then
151 if(inum(ialset(j)).gt.0) noutloc=noutloc+1
152 else
153 if(inum(ialset(j)).ne.0) noutloc=noutloc+1
154 endif
155 else
156 k=ialset(j-2)
157 do
158 k=k-ialset(j)
159 if(k.ge.ialset(j-1)) exit
160 if(iselect.eq.-1) then
161 if(inum(k).lt.0) noutloc=noutloc+1
162 elseif(iselect.eq.1) then
163 if(inum(k).gt.0) noutloc=noutloc+1
164 else
165 if(inum(k).ne.0) noutloc=noutloc+1
166 endif
167 enddo
168 endif
169 enddo
170 if(ngraph.gt.1) noutloc=noutloc*ngraph
171 endif
172 !
173 return
174 end*/
175
176
177