1! 2! CalculiX - A 3-dimensional finite element program 3! Copyright (C) 1998-2021 Guido Dhondt 4! 5! This program is free software; you can redistribute it and/or 6! modify it under the terms of the GNU General Public License as 7! published by the Free Software Foundation(version 2); 8! 9! 10! This program is distributed in the hope that it will be useful, 11! but WITHOUT ANY WARRANTY; without even the implied warranty of 12! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13! GNU General Public License for more details. 14! 15! You should have received a copy of the GNU General Public License 16! along with this program; if not, write to the Free Software 17! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 18! 19 subroutine objectives(inpc,textpart,istat,n,iline, 20 & ipol,inl,ipoinp,inp,ipoinpc,nobject,objectset, 21 & ier,nmethod,objective_flag) 22! 23! reading the input deck: *OBJECTIVE 24! 25 implicit none 26! 27 logical copy,objective_flag 28! 29 character*1 inpc(*) 30 character*132 textpart(16) 31 character*81 objectset(5,*) 32! 33 integer istat,n,key,i,iline,ipol,inl,ipoinp(2,*), 34 & inp(3,*),ipoinpc(0:*),nobject,ier,nmethod,iobject,j,icopy 35! 36 if(nmethod.ne.16) then 37 write(*,*) '*ERROR reading *OBJECTIVE' 38 write(*,*) ' *OBJECTIVE can only be defined' 39 write(*,*) ' within a *FEASIBLE DIRECTION STEP' 40 call inputerror(inpc,ipoinpc,iline,"*OBJECTIVE%",ier) 41 return 42 endif 43! 44 if(objective_flag) then 45 write(*,*) '*ERROR reading *OBJECTIVE' 46 write(*,*) ' *OBJECTIVE can only be defined' 47 write(*,*) ' once within a *FEASIBLE DIRECTION STEP' 48 call inputerror(inpc,ipoinpc,iline,"*OBJECTIVE%",ier) 49 return 50 endif 51! 52! check if it is a minimization or maximization problem 53! 54 if(textpart(2)(1:7).eq.'TARGET=') then 55 if(textpart(2)(8:10).eq.'MIN') then 56 objectset(2,1)(17:19)='MIN' 57 elseif(textpart(2)(8:10).eq.'MAX') then 58 objectset(2,1)(17:19)='MAX' 59 else 60 write(*,*) '*WARNING optimization TARGET not specified.' 61 write(*,*) ' Minimization problem assumed as' 62 write(*,*) ' default.' 63 objectset(2,1)(17:19)='MIN' 64 endif 65 else 66 write(*,*) '*WARNING optimization TARGET not specified.' 67 write(*,*) ' Minimization problem assumed as' 68 write(*,*) ' default.' 69 objectset(2,1)(17:19)='MIN' 70 endif 71! 72! reading the design response which should be used for this objective 73! 74 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 75 & ipoinp,inp,ipoinpc) 76! 77 if((textpart(1)(1:1).eq.'*').or.(istat.lt.0).or.(key.eq.1)) then 78 write(*,*) '*ERROR reading *OBJECTIVE' 79 write(*,*) ' no design response specified' 80 call inputerror(inpc,ipoinpc,iline,"*OBJECTIVE%",ier) 81 return 82 endif 83! 84! check if design response exists. if dr is already used, create a new 85! entry 86! 87 iobject=0 88 copy=.false. 89 icopy=0 90 do i=1,nobject 91 if(objectset(5,i)(1:80).eq.textpart(1)(1:80)) then 92 if(objectset(5,i)(81:81).ne.' ') then 93 icopy=i 94 copy=.true. 95 else 96 copy=.false. 97 iobject=i 98 exit 99 endif 100 endif 101 enddo 102! 103 if(copy) then 104 nobject=nobject+1 105 iobject=nobject 106 do j=1,5 107 objectset(j,iobject)(1:81)=objectset(j,icopy)(1:81) 108 enddo 109 endif 110! 111 if(iobject.eq.0) then 112 write(*,*) '*ERROR reading *OBJECTIVE' 113 write(*,*) ' given name of design ' 114 write(*,*) ' response does not exist.' 115 call inputerror(inpc,ipoinpc,iline,"*OBJECTIVE%",ier) 116 return; 117 endif 118! 119 objectset(5,iobject)(81:81)='O' 120 objectset(1,iobject)(19:20)=' ' 121! 122 call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl, 123 & ipoinp,inp,ipoinpc) 124! 125 return 126 end 127