root/src/frdset.c

/* [<][>][^][v][top][bottom][index][help] */

DEFINITIONS

This source file includes following definitions.
  1. frdset

   1 /*     CalculiX - A 3-dimensional finite element program                 */
   2 /*              Copyright (C) 1998-2015 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 
  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-2015 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 

/* [<][>][^][v][top][bottom][index][help] */