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