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