Vielen Dank, dass du mir helfen möchtest! Inzwischen nehme ich wieder den Source 2.0 Compiler (GFortran). Es ist folgendes unser Dozent hat uns einen Algorithmus zur Verfügung gestellt, für welchen wir ein Unterprogramm schreiben sollen. Dieser Algorithmus hat aber anfangs Fehler ausgegeben. Diese konnte ich, so hoffe ich zumindest fixen ohne den vorgegeben Algorithmus zu beschädigen. Es kommen zumindest nur noch Warnings. Dann wollte ich aus der Beschreibung, welche er uns ausgeteilt hat mal ein Unterprogramm mit aufrufendem Programm zu dem Algorithmus hinzufügen und nun kommt die Fehlermeldung, dass zwei Hauptprogramme existieren. Mir ist nun nicht bewusst wie ich diesen Fehler fixen kann bzw. wich diese Hauptprogramme zu einem Vereinen kann. Die Zeile 1 - 34 zu löschen macht für mich keinen Sinn, weil ein Input- und Output file existiert. Über das Outputfile sollten zumindest die Ergebnisse ausgegeben werden. Ich bin wirklich grad überfragt, wie ich das alles anstellen soll. Eine Einführung in die Programmierung bzw. die Sprache oder ähnliches hat nie stattgefunden.nufan hat geschrieben: ↑So Aug 05, 2018 4:15 pmBitte beschreibe genau was du gemacht hast und auf welche Fehler du gestoßen bist. Da du inzwischen ja auch den Compiler gewechselt hast, ist das sonst sehr mühsam nachzuvollziehen.
Nachdem ich aber davon ausgehe, dass du deine eigene Hauptfunktion verwenden möchtest, habe ich vom vorgegebenen Code die Zeilen 1 bis 34 gelöscht.
Hier hast du in deinem Code auch gleich zwei syntaktische Fehler:Weiters passt die Dimensionierung der Variable "X" in der Subroutine "GF" nicht zur erwarteten Größe in "GFUN".Code: Alles auswählen
IF=(LI,NE.0)RETURN
Hier noch mal mein veränderter Quellcode:
Code: Alles auswählen
INTEGER inp,iout
REAL*8 PAR
COMMON /DIAG/ INP,IOUT
COMMON /RUECK/ PAR(50)
inp=5
iout=6
OPEN (UNIT=inp ,FILE="C:\Users\T\Desktop\ZSS\GLOBEX_EINGABE.inp",
& ACCESS='sequential',STATUS='unknown')
OPEN (UNIT=IOUt,FILE="C:\Users\T\Desktop\ZSS\GLOBEX_AUSGABE.out",
& ACCESS='sequential',STATUS='unknown')
WRITE(IOUT,100)
100 format(///,1x,'.................................................'
# ,/,1x,'. .'
# ,/,1x,'. Rosenbrock Bananenfunktion mit k=2 und nres=2 .'
# ,/,1x,'. .'
# ,/,1x,'.................................................'
# ,//)
call EXTRE
close(unit=5)
close(unit=6)
stop
end
SUBROUTINE EXTRE
C...............................................................................
C. .
C. STEUERPROGRAMM FUER DIE OPTIMIERUNG MIT E X T R E M ODER G L O B E X .
C. .
C. PROGRAMMIERUNG: K.-J. JAKOBI .
C. DATUM : JUNI 1984 .
C. .
C...............................................................................
C. .
C. BESCHREIBUNG DER EINZULESENDEN PARAMETER : .
C. ------------------------------------------ .
C. .
C. .
C. K ZAHL DER ZU OPTIMIERENDEN UNABHAENGIGEN VARIABLEN .
C. .
C. NRES ZAHL DER UNGLEICHHEITSRESTRIKTIONEN .
C. .
C. U EINDIMENSIONALES FELD, IN DEM DIE K GESCHAETZTEN ANFANGSWERTE .
C. DER EINGANGSVARIABLEN ENTHALTEN SIND, DIE INNERHALB DER ER- .
C. LAUBTEN GRENZEN LIEGEN MUESSEN. AM ENDE DER OPTIMIERUNGS- .
C. PROZEDUR LIEFERT DIESES FELD DIE OPTIMALEN WERTE DIESER .
C. STEUERGROESSEN. .
C. .
C. DU EINDIMENSIONALES FELD, DAS DIE K ANFANGSSCHRITTWEITEN DER .
C. SUCHPROZEDUR DEFINIERT, D.H. ALLE DU(I) VERSCHIEDEN VON NULL. .
C. HINWEIS: DIE DU'S SOLLTEN NICHT ZU KLEIN GEW�HLT WERDEN, DAMIT .
C. EIN GROSSER BEREICH ABGEDECKT WIRD. DAS IST BESONDERS .
C. WICHTIG, WENN GLOBEX EINE ZULAESSIGE STARTLOESUNG .
C. SUCHT. .
C. .
C. .
C. DFMIN DIE OPTIMIERUNGSPROZEDUR WIRD BEENDET, SOBALD DIE ABSOLUTE .
C. VERAENDERUNG DER GUETEFUNKTION VON STUFE ZU STUFE KLEINER .
C. ALS DFMIN IST. .
C. .
C. DUMIN UNTERBRECHUNG DER OPTIMIERUNG, FALLS INNERHALB DER LETZTEN .
C. STUFE DIE ABSOLUTE VERAENDERUNG DES NORMIERTEN STEUERGROES- .
C. SENVEKTORS KLEINER ALS DUMIN IST. .
C. .
C. LMAX DIE SUCHE DES EXTREMUMS WIRD ABGESCHLOSSEN, SOBALD DIE .
C. ANZAHL DER OPTIMIERUNGSSTUFEN DIE ZAHL LMAX ERREICHT. .
C. DAS VORZEICHEN VON LMAX GIBT AN, OB EIN MAXIMUM (POSITIVES .
C. VORZEICHEN) ODER EIN MINIMUM (NEGATIVES VORZEICHEN) GESUCHT .
C. WIRD. .
C. .
C. L1M L1M GIBT DIE ANZAHL DER IM ERSTEN OPTIMIERUNGSABSCHNITT ZU BE- .
C. STIMMENDEN ZUFALLSPUNKTE AN. .
C. .
C. L2M L2M GIBT DIE ANZAHL DER IM ZWEITEN OPTIMIERUNGSABSCHNITT ZU BE- .
C. STIMMENDEN ZUFALLSPUNKTE AN. .
C. L1M UND L2M SOLLTEN NICHT ZU KLEIN GEWAEHLT WERDEN, MINDESTENS .
C. ETWA 10*K, WOBEI K DIE ANZAHL DER ENTWURFSVARIABLEN IST. .
C. .
C. LPAR DER PARAMETER LPAR BESTIMMT DIE ANZAHL DER WAEHREND JEDER TEIL- .
C. OPTIMIERUNG DURCHZUFUEHRENDEN OPTIMIERUNGSSTUFEN. ALS RICHTWERT .
C. KANN ETWA 0.1*LMAX EINGESETZT WERDEN. FALLS DIE TEILOPTIMIERUNG .
C. NICHT GEWUENSCHT WIRD, IST LPAR=0 EINZUSETZEN. IM UEBRIGEN MUSS .
C. LPAR NICHT ENTSPRECHEND LMAX MIT VORZEICHEN - ZUR SUCHE EINES .
C. MAXIMUMS ODER MINIMUMS - VERSEHEN WERDEN, D. H. VORZEICHEN VON .
C. LPAR IST BELIEBIG. .
C. .
C. IW SCHREIBBEFEHL. .
C. IW=+1 KEIN AUSDRUCKEN VON RESULATEN. (DIE ENTSPRECHENDEN WERTE .
C. WERDEN Z. BSP. IN DAS AUFRUFENDE PROGRAMM UEBERTRAGEN) .
C. IW=2 AUSDRUCK DES ANFANGSWERTES FUER JEDEN ABSCHNITT UND DRUCK .
C. DER ENDERGEBNISSE. .
C. IW=3 AUSDRUCK DER RESULTATE AM ENDE JEDER OPTIMIERUNGSSTUFE .
C. UND AUSDRUCK DER WERTE NACH JEDER TEILOPTIMIERUNG (SOFERN .
C. VERBESSERUNG). ZUSAETZLICH WERDEN BEI IW=3 UND ANFANGS- .
C. WERTEN AUSSERHALB DES ZULAESSIGEN BEREICHS DIE ERZEUGTEN .
C. ZUFALLSVEKTOREN SOLANGE AUSGEDRUCKT, BIS EIN ZULAESSIGER .
C. ENTWURF GEFUNDEN WORDEN IST. .
C. .
C IART STEUERPARAMETER .
C. IART=0 OPTIMIERUNG MIT GLOBEX .
C. IART=1 OPTIMIERUNG MIT EXTREM .
C. FALLS DER STARTVEKTOR NICHT ZUL�SSIG IST ERFOLGT DIE .
C. UMSCHALTUNG AUF DIE OPTIMIERUNG MIT GLOBEX .
C. .
C.-----------------------------------------------------------------------------.
C. .
C. INP KANALNUMMER DES EINGABEKANALS .
C. IOUT KANALNUMMER DES EINGABEKANALS .
C. .
C. INP UND IOUT WERDEN IM COMMONBLOCK COMMON /DIAG/ INP,IOUT .
C. �BERGEBEN .
C. .
C...............................................................................
IMPLICIT NONE
REAL*8 dfmin , DU , dumin , fmin , G , tend , time , tstart , U ,
& WORk , XSOl
INTEGER i , iart , INP , IOUt , ires , iw , k , kdim , l1m , l2m ,
& lmax , lpar , NF , NG , nres
COMMON /EXTR / WORk(700) , U(100) , DU(100) , G(100) , NF , NG
COMMON /DIAG / INP , IOUt
COMMON /SOLU / XSOl(50)
C-----------------------
C EINLESEN DER DATEN
C-----------------------
C
C KARTENTYP 1 : FORMAT(8I5)
C
READ (INP,99003) k , nres , lmax , l1m , l2m , lpar , iw , iart
IF ( k.LT.1 ) RETURN
WRITE (IOUt,99004)
WRITE (IOUt,99005) k , nres , lmax , l1m , l2m , lpar , iw , iart
C
C KARTENTYP 2 : FORMAT(8F10.0)
C
READ (INP,99006) (U(i),i=1,k)
C
C KARTENTYP 3 : FORMAT(8F10.0)
C
READ (INP,99006) (DU(i),i=1,k)
C
C KARTENTYP 4 : FORMAT(2F10.0)
C
READ (INP,99006) dumin , dfmin
C-----------------------------
C ENDE EINLESEN DER DATEN
C-----------------------------
WRITE (IOUt,99007)
WRITE (IOUt,99008) (U(i),i=1,k)
WRITE (IOUt,99009)
WRITE (IOUt,99008) (DU(i),i=1,k)
WRITE (IOUt,99010)
WRITE (IOUt,99011) dumin , dfmin
WRITE (IOUt,99012)
NF = 0
NG = 0
IF ( iart.NE.0 ) THEN
C---------------------
C LOKALE EXTREMWERTSUCHE MIT E X T R E M
C---------------------
WRITE (IOUt,99014)
kdim = k
lmax = -IABS(lmax)
C---------------------
C PRUEFEN OB STARTVEKTOR ZULAESSIG IST
C---------------------
IF ( nres.NE.0 ) THEN
WRITE (IOUt,99001) (U(i),i=1,k)
CALL GFUN(G,U)
NG = NG + 1
WRITE (IOUt,99018)
WRITE (IOUt,99008) (G(i),i=1,nres)
DO ires = 1 , nres
IF ( G(ires).GT.0.D00 ) THEN
WRITE (IOUt,99015)
GOTO 100
ENDIF
ENDDO
ENDIF
CALL CPUSEC(tstart)
CALL EXTREM(K,NRES,U,DU,WORK(1),DFMIN,DUMIN,
# LMAX,FMIN,IW,IOUT,KDIM)
CALL CPUSEC(tend)
GOTO 110
ENDIF
C--------------------
C GLOBALE EXTREMWERTSUCHE MIT G L O B E X
C--------------------
100 WRITE (IOUt,99013)
kdim = k
lmax = -IABS(lmax)
IF ( lmax.EQ.0 ) lmax = -100*k
IF ( lpar.LE.0 ) lpar = IABS(lmax)/10
IF ( lpar.EQ.0 ) lpar = IABS(lmax)
IF ( l1m.LE.0 ) l1m = 10*k
IF ( l2m.LE.0 ) l2m = 10*k
CALL CPUSEC(tstart)
CALL GLOBEX(k,nres,U,DU,WORk(1),dfmin,dumin,lmax,fmin,l1m,l2m,
& lpar,iw,IOUt,kdim)
CALL CPUSEC(tend)
C---------------------
C AUSGABE DER ERGEBNISSE
C---------------------
110 WRITE (IOUt,99002)
WRITE (IOUt,99016)
WRITE (IOUt,99008) (U(i),i=1,k)
WRITE (IOUt,99017) fmin
IF ( nres.GT.0 ) THEN
CALL GFUN(G,U)
NG = NG + 1
WRITE (IOUt,99018)
WRITE (IOUt,99008) (G(ires),ires=1,nres)
ENDIF
time = tend - tstart
WRITE (IOUt,99019) NF , NG , time
DO i = 1 , k
XSOl(i) = U(i)
ENDDO
RETURN
99001 FORMAT (1X,'U = ',8G12.5)
C------------------------------------------------------------------------------
99002 FORMAT (///,3(
&'#################################################################
&#####################################',/),//)
99003 FORMAT (16I5)
99004 FORMAT (/////,1X,'NICHTLINEARE OPTIMIERUNG MIT GLOBEX - EXTREM',/,
& 1X,'********************************************',
& ////////////)
99005 FORMAT (//,1X,'STEUERPARAMETER',/,1X,'K =',I5,/,1X,'NRES =',I5,
& /,1X,'LMAX =',I5,/,1X,'L1M =',I5,/,1X,'L2M =',I5,/,1X,
& 'LPAR =',I5,/,1X,'IW =',I5,/,1X,'IART =',I5,///////)
99006 FORMAT (8F10.0)
99007 FORMAT (1X,'STARTVEKTOR')
99008 FORMAT (1X,8G12.5)
99009 FORMAT (//,1X,'ANFANGSSCHRITTWEITENVEKTOR')
99010 FORMAT (//,1X,'ABBRUCHKRITERIEN')
99011 FORMAT (1X,'DUMIN=',G12.5,' DFMIN=',G12.5)
99012 FORMAT (///,1X,'******** START DER BERECHNUNG ********',//)
99013 FORMAT (1X,'++++++ OPTIMIERUNG MIT G L O B E X ++++++',//)
99014 FORMAT (1X,'++++++ OPTIMIERUNG MIT E X T R E M ++++++',//)
99015 FORMAT (//,1X,'!!!!!!! EXTREM WURDE MIT UNZULAESSIGEM !!!!!!',/,
& 1X,'!!!!!!! STARTVEKTOR GESTARTET !!!!!!',/,1X,
& '!!!!!!! UMSCHALTUNG AUF OPTIMIERUNG !!!!!!',/,1X,
& '!!!!!!! MIT G L O B E X !!!!!!'////)
99016 FORMAT (//,1X,'ERGEBNISSE DER OPTIMIERUNG',/,1X,
& '==========================',//,1X,'LOESUNGSVEKTOR')
99017 FORMAT (//,1X,'ERREICHTER MINIMALER FUNKTIONSWERT=',D20.10)
99018 FORMAT (/,1X,'RESTRIKTIONSWERTE')
99019 FORMAT (/////,1X,'ANZAHL DER FUNKTIONSAUSWERTUNGEN =',I10,/,1X,
& 'ANZAHL DER RESTRIKTIONSAUSWERTUNGEN=',I10,/,1X,
& 'RECHENZEIT IN MILLISEKUNDEN =',F10.1,///,1X,
& 50('-.'),'-',///)
END
SUBROUTINE GLOBEX(K,Nres,U,Du,S,Dfmin,Dumin,Lmax,F2,L1m,L2m,Lpar,
& Iw,Ip,Kdim)
IMPLICIT NONE
INTEGER i , idr , Ip , Iw , K , Kdim , L1m , L2m , li , Lmax ,
& lp , Lpar , m , nm , Nres
C...............................................................................
C. .
C. .
C. EXTREMWERTSUCHE AN EINER BESCHRAENKTEN MULTIVARIABLEN FUNKTION .
C. OHNE KENNTNIS IHRER ABLEITUNGEN (H.G.JACOB, 8.DEZ.1980) .
C. .
C. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! .
C. .
C. DOPPELTGENAUE VERSION .
C. .
C. DIE PARAMETER U,DU,S,DFMIN,DUMIN,F2 MUESSEN IM RUFENDEN PROGRAMM .
C. ALS DOPPELTGENAU DEKLARIERT WERDEN. .
C. .
C. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! .
C. .
C.-------------------------------------------------------------------------- .
C. MIT DIESM PROGRAMM G L O B E X IST ES EINMAL MOEGLICH, MIT GROSSER .
C. WAHRSCHEINLICHKEIT DAS GLOBALE EXTREMUM EINER MULTIVARIABLEN FUNKTION .
C. ZU BESTIMMEN. ZUM ANDEREN KOENNEN DAMIT BEI BESCHRAENKTEN FUNKTIONEN .
C. AUCH ANFANGSSCHAETZWERTE FUER DIE OPTIMIERUNGSVARIABLEN GEFUNDEN .
C. WERDEN, WELCHE DIE GEGEBENEN BEGRENZUNGEN NICHT VERLETZEN. .
C. .
C. ERMITTLUNG VON GLOBALEN EXTREMA: .
C. -------------------------------- .
C. IN DIESEM PROGRAMM GLOBEX WERDEN IN EINEM ERSTEN OPTIMIERUNGSSCHRITT .
C. SCHAETZWERTE DURCH EINE FOLGE VON NORMALVERTEILTEN ZUFALLSZAHLEN FEST- .
C. GELEGT. VEKTORIELLER MITTELWERT DIESER NORMALVERTEILTEN PUNKTE IST EIN .
C. VOM ANWENDER EINGEGEBENER ANFANGSSCHAETZWERT U. DIE JEWEILIGEN MITT- .
C. LEREN QUADRATISCHEN ABWEICHUNGEN SIND DURCH DIE ANFANGSSCHRITTWEITEN .
C. DU GEGEBEN. AN JEDEM DIESER PUNKTE WIRD, SOFERN ER INNERHALB DER EVTL. .
C. VORHANDENEN GRENZEN LIEGT, EINE TEILOPTIMIERUNG MIT DEM PROGRAMM .
C. EXTREM GESTARTET. .
C. IM ZWEITEN OPTIMIERUNGSSCHRITT WERDEN UM DEN BIS DAHIN GEFUNDENEN .
C. BESTEN FUNKTIONSWERT HERUM EBENFALLS ZUFALLSSCHAETZWERTE ERMITTELT UND .
C. AN JEDEM DIESER PUNKTE WIRD WIEDERUM EINE TEILOPTIMIERUNG UNTER .
C. BERUECKSICHTIGUNG EVTL. BEGRENZUNGEN GESTARTET. IST EIN GUENSTIGERER .
C. FUNKTIONSWERT GEFUNDEN WORDEN, SO WIRD DIESER PUNKT ZUM NEUEN MITTEL- .
C. WERT FUER DIE WEITERE ZUFALLSSUCHE UND DIE MITTLEREN QUADRATISCHEN AB- .
C. WEICHUNGEN WERDEN MIT 0.9 MULTIPLIZIERT (EINGRENZUNG DES GLOBALEN .
C. EXTREMUMS). .
C. DER GUENSTIGSTE ALLER IN DIESEN BEIDEN ABSCHNITTEN ERMITTELTEN WERTE .
C. WIRD GESPEICHERT UND IN EINEM DRITTEN OPTIMIERUNGSABSCHNITT ALS .
C. ANFANGSWERT FUER DIE (HAUPT-) OPTIMIERUNG MIT DEM PROGRAMM EXTREM EIN- .
C. GESETZT. .
C. .
C. BEDEUTUNG DER PARAMETER: .
C. ------------------------ .
C. .
C. .
C. K ZAHL DER ZU OPTIMIERENDEN UNABHAENGIGEN VARIABLEN .
C. .
C. NRES ZAHL DER UNGLEICHHEITSRESTRIKTIONEN .
C. .
C. U EINDIMENSIONALES FELD, IN DEM DIE K GESCHAETZTEN ANFANGSWERTE .
C. DER EINGANGSVARIABLEN ENTHALTEN SIND, DIE INNERHALB DER ER- .
C. LAUBTEN GRENZEN LIEGEN MUESSEN. AM ENDE DER OPTIMIERUNGS- .
C. PROZEDUR LIEFERT DIESES FELD DIE OPTIMALEN WERTE DIESER .
C. STEUERGROESSEN. .
C. .
C. DU EINDIMENSIONALES FELD, DAS DIE K ANFANGSSCHRITTWEITEN DER .
C. SUCHPROZEDUR DEFINIERT, D.H. ALLE DU(I) VERSCHIEDEN VON NULL. .
C. .
C. S ZWEIDIMENSIONALER ARBEITSSPEICHERPLATZ (KDIM,7) .
C. .
C. DFMIN DIE OPTIMIERUNGSPROZEDUR WIRD BEENDET, SOBALD DIE ABSOLUTE .
C. VERAENDERUNG DER GUETEFUNKTION VON STUFE ZU STUFE KLEINER .
C. ALS DFMIN IST. .
C. .
C. DUMIN UNTERBRECHUNG DER OPTIMIERUNG, FALLS INNERHALB DER LETZTEN .
C. STUFE DIE ABSOLUTE VERAENDERUNG DES NORMIERTEN STEUERGROES- .
C. SENVEKTORS KLEINER ALS DUMIN IST. .
C. .
C. LMAX DIE SUCHE DES EXTREMUMS WIRD ABGESCHLOSSEN, SOBALD DIE .
C. ANZAHL DER OPTIMIERUNGSSTUFEN DIE ZAHL LMAX ERREICHT. .
C. DAS VORZEICHEN VON LMAX GIBT AN, OB EIN MAXIMUM (POSITIVES .
C. VORZEICHEN) ODER EIN MINIMUM (NEGATIVES VORZEICHEN) GESUCHT .
C. WIRD. .
C. .
C. F2 WERT DER GUETEFUNKTION AM ENDE DER OPTIMIERUNGSPROZEDUR. .
C. .
C. L1M L1M GIBT DIE ANZAHL DER IM ERSTEN OPTIMIERUNGSABSCHNITT ZU BE- .
C. STIMMENDEN ZUFALLSPUNKTE AN. .
C. .
C. L2M L2M GIBT DIE ANZAHL DER IM ZWEITEN OPTIMIERUNGSABSCHNITT ZU BE- .
C. STIMMENDEN ZUFALLSPUNKTE AN. .
C. L1M UND L2M SOLLTEN NICHT ZU KLEIN GEWAEHLT WERDEN, MINDESTENS .
C. ETWA 10*K, WOBEI K DIE ANZAHL DER ENTWURFSVARIABLEN IST. .
C. .
C. LPAR DER PARAMETER LPAR BESTIMMT DIE ANZAHL DER WAEHREND JEDER TEIL- .
C. OPTIMIERUNG DURCHZUFUEHRENDEN OPTIMIERUNGSSTUFEN. ALS RICHTWERT .
C. KANN ETWA 0.1*LMAX EINGESETZT WERDEN. FALLS DIE TEILOPTIMIERUNG .
C. NICHT GEWUENSCHT WIRD, IST LPAR=0 EINZUSETZEN. IM UEBRIGEN MUSS .
C. LPAR NICHT ENTSPRECHEND LMAX MIT VORZEICHEN - ZUR SUCHE EINES .
C. MAXIMUMS ODER MINIMUMS - VERSEHEN WERDEN, D. H. VORZEICHEN VON .
C. LPAR IST BELIEBIG. .
C. .
C. IW SCHREIBBEFEHL. .
C. IW=+1 KEIN AUSDRUCKEN VON RESULATEN. (DIE ENTSPRECHENDEN WERTE .
C. WERDEN Z. BSP. IN DAS AUFRUFENDE PROGRAMM UEBERTRAGEN) .
C. IW=2 AUSDRUCK DES ANFANGSWERTES FUER JEDEN ABSCHNITT UND DRUCK .
C. DER ENDERGEBNISSE. .
C. IW=3 AUSDRUCK DER RESULTATE AM ENDE JEDER OPTIMIERUNGSSTUFE .
C. UND AUSDRUCK DER WERTE NACH JEDER TEILOPTIMIERUNG (SOFERN .
C. VERBESSERUNG). ZUSAETZLICH WERDEN BEI IW=3 UND ANFANGS- .
C. WERTEN AUSSERHALB DES ZULAESSIGEN BEREICHS DIE ERZEUGTEN .
C. ZUFALLSVEKTOREN SOLANGE AUSGEDRUCKT, BIS EIN ZULAESSIGER .
C. ENTWURF GEFUNDEN WORDEN IST. .
C. .
C. IP KANALNUMMER DER AUSGABEEINHEIT .
C. .
C. KDIM DIE FELDER U,DU,S SIND IM RUFENDEN PROGRAMM MIT .
C. U(KDIM),DU(KDIM),S(KDIM,7) DIMENSIONIERT. KDIM >= K . .
C. .
C.------------------------------------------------------------------------ .
C. .
C. LITERATUR: H. G. JACOB .
C. 'RECHNERUNTERSTUETZE OPTIMIERUNG STATISCHER UND .
C. DYNAMISCHER SYSTEME' .
C. SPRINGER VERLAG, BERLIN, 1982 .
C. .
C...............................................................................
REAL*8 U , Du , S , Dfmin , Dumin , F2 , fb , staw
DIMENSION U(Kdim) , Du(Kdim) , S(Kdim,1)
EXTERNAL GF
li = 0
staw = 1.D00
nm = 0
idr = 0
lp = ISIGN(Lpar,Lmax)
DO i = 1 , K
S(i,6) = U(i)
S(i,7) = U(i)
ENDDO
CALL GF(U,fb,li,m,Nres)
m = 0
IF ( li.NE.0 ) THEN
WRITE (Ip,99001) li
DO WHILE ( .TRUE. )
IF ( Iw.EQ.3 ) WRITE (Ip,99002) m , li , (i,S(i,7),i=1,K)
DO i = 1 , K
CALL ZNORV1(nm,S(i,6),Du(i),S(i,7))
ENDDO
IF ( m.LE.IABS(Lmax) ) THEN
li = 0
CALL GF(S(1,7),fb,li,m,Nres)
IF ( li.EQ.0 ) THEN
DO i = 1 , K
S(i,6) = S(i,7)
U(i) = S(i,7)
ENDDO
EXIT
ENDIF
ELSE
WRITE (Ip,99004) m
RETURN
ENDIF
ENDDO
ENDIF
IF ( Iw.GE.2 ) WRITE (Ip,99003) m , fb , staw , fb ,
& (i,U(i),i=1,K)
IF ( m.GT.L1m+L2m ) GOTO 200
100 IF ( lp.NE.0 ) CALL EXTREM(K,Nres,S(1,7),Du,S,Dfmin,Dumin,lp,F2,1,
& Ip,Kdim)
IF ( DBLE(FLOAT(lp))*(F2-fb).GT.0.D00 ) THEN
IF ( Iw.GE.3 ) WRITE (Ip,99003) m , F2 , staw , fb ,
& (i,S(i,7),i=1,K)
fb = F2
DO i = 1 , K
IF ( m.GT.L1m ) Du(i) = Du(i)*0.9D00
U(i) = S(i,7)
ENDDO
IF ( m.GT.L1m .AND. m.LT.L1m+L2m ) staw = staw*0.9D00
ENDIF
DO WHILE ( .TRUE. )
IF ( Iw.GE.2 .AND. (m.EQ.L1m .AND. idr.EQ.0 .OR. m.GE.L1m+L2m)
& ) WRITE (Ip,99003) m , fb , staw , fb , (i,U(i),i=1,K)
IF ( m.EQ.L1m ) idr = 1
IF ( m.GE.L1m+L2m ) EXIT
DO i = 1 , K
IF ( m.LT.L1m ) CALL ZNORV1(nm,S(i,6),Du(i),S(i,7))
IF ( m.GE.L1m ) CALL ZNORV1(nm,U(i),Du(i),S(i,7))
ENDDO
li = 0
CALL GF(S(1,7),F2,li,m,Nres)
IF ( li.EQ.0 ) GOTO 100
ENDDO
200 CALL EXTREM(K,Nres,U,Du,S,Dfmin,Dumin,Lmax,F2,Iw,Ip,Kdim)
RETURN
C------------------------------------------------------------------------------
99001 FORMAT (/' ANFANGSWERTE VERLETZEN BEGRENZUNG, LI=',I3/1X,41('*'))
99002 FORMAT (/' M=',I4,' LI=',I2,/4(' U(',I2,')=',D12.5,1X))
99003 FORMAT (/' M=',I4,' F=',D13.6,' STAW=',D10.3,' FB=',D12.5,
& /4(' U(',I2,')=',D12.5))
99004 FORMAT (///,1X,'ES KONNTE KEIN ZULAESSIGER STARTPUNKT IN',I5,
& ' ZUFALLSSCHRITTEN GEFUNDEN WERDEN !!!!!!!!!')
END
SUBROUTINE ZNORV1(Nm,Gmw,Gmqa,Znv)
IMPLICIT NONE
INTEGER i , Nm
C...............................................................................
C. .
C. ERZEUGUNG VON NORMALVERTEILTEN ZUFALLSZAHLEN MIT GMW ALS .
C. GEWUENSCHTEM MITTELWERT UND GMQA ALS GEWUENSCHTER MITTLERER .
C. QUADRATISCHER ABWEICHUNG, D. H. CA. 70 PROZENT DER ERZEUGTEN ZAHLEN .
C. LIEGEN ZWISCHEN GMW-GMQA UND GMW+GMQA (H.G. JACOB, 28.JUNI.1980) .
C. NM = INITIALISIERUNG DER PERIODE DER PSEUDOZUFALLSZAHLEN DURCH SETZEN .
C. VON NM=0 (REPRODUZIERBARKEIT DER ZAHELNFOLGE) .
C. GMW = GEWUENSCHTER MITTELWERT .
C. GMQA = GEWUENSCHTE QUADRATISCHE ABWEICHUNG .
C. ZNV = NORMALVERTEILTE ZUFALLSZAHL, WOBEI DIE VARIATIONSBREITE 12*GMQA .
C. BETRAEGT .
C. D. H. ZNVMIN>= GMW-6*GMQA UND ZNVMAX<= GMW+6*GMQA .
C...............................................................................
REAL*8 Gmw , Gmqa , Znv , zuv , a , em , xi
DIMENSION zuv(12)
DATA a , em , xi/181.D00 , 524288.D00 , 123.D00/
IF ( Nm.EQ.0 ) xi = 123.D00
Znv = 0.D00
DO i = 1 , 12
xi = a*xi
DO WHILE ( .TRUE. )
IF ( xi.GT.em ) xi = xi - em
IF ( xi.LE.em ) THEN
zuv(i) = xi/em
Nm = Nm + 1
Znv = Znv + zuv(i)
EXIT
ENDIF
ENDDO
ENDDO
Znv = Gmqa*(Znv-6.D00) + Gmw
END
SUBROUTINE EXTREM(K,Nres,U,Du,S,Dfmin,Dumin,Lmax,F2,Iw,Ip,
# Kdim)
IMPLICIT NONE
INTEGER i , Ip , is , Iw , j , K , kd , Kdim , l , li , lj ,
& Lmax , m , n , Nres
C...............................................................................
C. .
C. .
C. EXTREMWERTSUCHE AN EINER BESCHRAENKTEN MULTIVARIABLEN FUNKTION .
C. OHNE KENNTNIS IHRER ABLEITUNGEN (H.G.JACOB, 8.DEZ.1980) .
C. .
C. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! .
C. .
C. DOPPELTGENAUE VERSION .
C. .
C. DIE PARAMETER U,DU,S,DFMIN,DUMIN,F2 MUESSEN IM RUFENDEN PROGRAMM .
C. ALS DOPPELTGENAU DEKLARIERT WERDEN. .
C. .
C. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! .
C. .
C.-------------------------------------------------------------------------- .
C. .
C. DAS UNTERPROGRAMM EXTREM, DAS VON EINEM GEGEBENEN ANFANGSPUNKT DAS .
C. NAECHSTGELEGENE MAXIMUM ODER MINIMUM EINER MOEGLICHERWEISE BE- .
C. SCHRAENKTEN UND MULTIVARIABLEN FUNKTION ODER FUNKTIONALS AUFFINDET, .
C. KANN VON EINEM BELIEBIGEN PROGRAMM DES BENUTZERS AUFGERUFEN WERDEN. .
C. .
C. BEDEUTUNG DER PARAMETER: .
C. ------------------------ .
C. .
C. .
C. K ZAHL DER ZU OPTIMIERENDEN UNABHAENGIGEN VARIABLEN .
C. .
C. NRES ZAHL DER UNGLEICHHEITSRESTRIKTIONEN .
C. .
C. U EINDIMENSIONALES FELD, IN DEM DIE K GESCHAETZTEN ANFANGSWERTE .
C. DER EINGANGSVARIABLEN ENTHALTEN SIND, DIE INNERHALB DER ER- .
C. LAUBTEN GRENZEN LIEGEN MUESSEN. AM ENDE DER OPTIMIERUNGS- .
C. PROZEDUR LIEFERT DIESES FELD DIE OPTIMALEN WERTE DIESER .
C. STEUERGROESSEN. .
C. .
C. DU EINDIMENSIONALES FELD, DAS DIE K ANFANGSSCHRITTWEITEN DER .
C. SUCHPROZEDUR DEFINIERT, D.H. ALLE DU(I) VERSCHIEDEN VON NULL. .
C. .
C. S ZWEIDIMENSIONALER ARBEITSSPEICHERPLATZ (KDIM,5) .
C. .
C. DFMIN DIE OPTIMIERUNGSPROZEDUR WIRD BEENDET, SOBALD DIE ABSOLUTE .
C. VERAENDERUNG DER GUETEFUNKTION VON STUFE ZU STUFE KLEINER .
C. ALS DFMIN IST. .
C. .
C. DUMIN UNTERBRECHUNG DER OPTIMIERUNG, FALLS INNERHALB DER LETZTEN .
C. STUFE DIE ABSOLUTE VERAENDERUNG DES NORMIERTEN STEUERGROES- .
C. SENVEKTORS KLEINER ALS DUMIN IST. .
C. .
C. LMAX DIE SUCHE DES EXTREMUMS WIRD ABGESCHLOSSEN, SOBALD DIE .
C. ANZAHL DER OPTIMIERUNGSSTUFEN DIE ZAHL LMAX ERREICHT. .
C. DAS VORZEICHEN VON LMAX GIBT AN, OB EIN MAXIMUM (POSITIVES .
C. VORZEICHEN) ODER EIN MINIMUM (NEGATIVES VORZEICHEN) GESUCHT .
C. WIRD. .
C. .
C. F2 WERT DER GUETEFUNKTION AM ENDE DER OPTIMIERUNGSPROZEDUR. .
C. .
C. IW SCHREIBBEFEHL. .
C. IW=+1 KEIN AUSDRUCKEN VON RESULTATEN. DIE WERTE WERDEN .
C. INS RUFENDE PROGRAMM UEBERTRAGEN. .
C. IW=+2 NUR DRUCKEN DER ENDERGEBNISSE. .
C. IW=+3 RESULTATE AM ENDE JEDER OPTIMIERUNGSSTUFE. .
C. .
C. IP KANALNUMMER DER AUSGABEEINHEIT .
C. .
C. KDIM DIE FELDER U,DU,S SIND IM RUFENDEN PROGRAMM MIT .
C. U(KDIM),DU(KDIM),S(KDIM,5) DIMENSIONIERT. KDIM >= K . .
C. .
C.------------------------------------------------------------------------ .
C. .
C. LITERATUR: H. G. JACOB .
C. 'RECHNERUNTERSTUETZE OPTIMIERUNG STATISCHER UND .
C. DYNAMISCHER SYSTEME' .
C. SPRINGER VERLAG, BERLIN, 1982 .
C. .
C...............................................................................
REAL*8 U , Du , S , dd , Dfmin , Dumin , f1 , F2 , f3 , ff , fff
REAL*8 eps , a2 , fg , fl , cs , ds , df , ce , vv , st , uu , fn
DIMENSION U(1) , Du(1) , S(Kdim,1) , dd(2)
fff = 0.D00
f1 = fff
f3 = fff
eps = 1.D-30
dd(1) = DSQRT(DBLE(FLOAT(K)))
dd(2) = dd(1)
kd = 0
l = 0
n = 0
a2 = DBLE(FLOAT(ISIGN(2,Lmax)))
li = 0
C
C BERECHNUNG DER DEN ANFANGSWERTEN ENTSPRECHENDE GUETEFUNKTION
C
CALL GF(U,F2,li,n,Nres)
IF ( li.NE.0 ) WRITE (Ip,99001) li
ff = F2
fg = F2
fl = F2
DO i = 1 , K
S(i,5) = U(i)/Du(i) - 1.D00
ENDDO
DO WHILE ( .TRUE. )
cs = 0.D00
DO i = 1 , K
S(i,1) = U(i)/Du(i)
S(i,2) = S(i,1) - S(i,5)
S(i,4) = 0.D00
S(i,5) = S(i,1)
cs = cs + S(i,2)**2
ENDDO
ds = DSQRT(cs)
df = F2 - fl
IF ( Iw.EQ.3 ) WRITE (Ip,99002) l , n , ds , df , F2 , dd(1) ,
& dd(2) , fg , (i,U(i),i=1,K)
IF ( .NOT.(l.GE.IABS(Lmax) .OR. li.NE.0 .AND. l.EQ.0 .OR.
& l.GT.2 .AND. (ds.LT.Dumin .OR. DABS(df).LT.Dfmin)) ) THEN
IF ( cs.LT.eps ) cs = 1.D00
fl = F2
l = l + 1
j = 1
C
C OPTIMIERUNG ENTLANG DER K SUCHRICHTUNGEN
C
DO m = 1 , K
IF ( 20.D00*dd(j).LT.ds ) dd(j) = ds
ce = -4.D00
vv = DSQRT(cs)
is = 0
DO i = 1 , K
U(i) = (S(i,1)+S(i,2)/vv*dd(j))*Du(i)
S(i,3) = U(i)/Du(i) - S(i,1)
ENDDO
li = 0
CALL GF(U,f3,li,n,Nres)
IF ( li.NE.0 ) ce = -ce*0.5D00
IF ( li.EQ.0 ) THEN
DO i = 1 , K
U(i) = (S(i,1)-S(i,3))*Du(i)
ENDDO
CALL GF(U,f1,li,n,Nres)
IF ( li.NE.0 ) ce = ce*0.5D00
fff = DABS(f1-2.D00*F2+f3)
ENDIF
DO WHILE ( .TRUE. )
st = 0.D00
is = is + 1
DO i = 1 , K
U(i) = S(i,1)*Du(i)
ENDDO
IF ( is.GT.5 ) EXIT
ce = -ce*0.25D00
DO i = 1 , K
U(i) = (S(i,1)+S(i,3)*ce)*Du(i)
C
C PARABOLISCHE EXTRAPOLATION BZW INTERPOLATION
C
IF ( fff.GE.eps .AND. li.EQ.0 ) U(i)
& = (S(i,1)+S(i,3)*DABS(ce)/fff*(f3-f1)/a2)
& *Du(i)
st = st + (U(i)/Du(i)-S(i,1))**2
ENDDO
C
C GEGEBENENFALLS VERKLEINERUNG DES SUCHSCHRITTES
C
IF ( 16.D00*st.LT.dd(j)**2 ) dd(j) = dd(j)*0.25D00
IF ( .NOT.(st.LT.400.D00*dd(j)**2 .AND. fff.GT.eps
& .OR. li.NE.0) ) THEN
DO i = 1 , K
IF ( DABS(S(i,3)).GE.eps .AND. DABS(f3-f1)
& .GE.eps ) U(i)
& = (S(i,1)+DSIGN(S(i,3),(f3-f1)/S(i,3))
& *10.D00*a2*DABS(ce))*Du(i)
ENDDO
C
C GEGEBENENFALLS VERGROESSERUNG DES SUCHSCHRITTES
C
dd(j) = dd(j)*2.D00
ENDIF
lj = 0
CALL GF(U,fn,lj,n,Nres)
IF ( lj.EQ.0 .AND. a2*(fn-fg).GE.0.D00 ) THEN
F2 = fn
IF ( a2*(ff-F2).LT.0.D00 ) fg = (ff+F2)*0.5D00
IF ( a2*(ff-F2).LT.0.D00 ) ff = F2
EXIT
ENDIF
ENDDO
IF ( m.EQ.K ) GOTO 100
DO WHILE ( .TRUE. )
C
C GRAM SCHMIDT ORTHOGONALISIERUNG
C
kd = kd - (kd/K)*K + 1
uu = 0.D00
DO i = 1 , K
S(i,3) = S(i,4) - S(kd,2)/cs*S(i,2)
IF ( i.EQ.kd ) S(i,3) = S(i,3) + 1.D00
uu = uu + S(i,3)**2
ENDDO
IF ( uu.GE.eps ) THEN
DO i = 1 , K
S(i,1) = U(i)/Du(i)
S(i,2) = S(i,3)
S(i,4) = S(i,3)
ENDDO
S(kd,4) = S(kd,3) - 1.D00
cs = uu
j = 2
EXIT
ENDIF
ENDDO
ENDDO
ENDIF
IF ( Iw.EQ.2 ) WRITE (Ip,99002) l , n , ds , df , F2 , dd(1) ,
& dd(2) , fg , (i,U(i),i=1,K)
EXIT
100 ENDDO
99001 FORMAT (' ANFANGSWERTE VERLETZEN BEGRENZUNG, LI=',I3/1X,41('*'))
99002 FORMAT (//' STUFE NR.',I4,7X,'SCHRITT NR.',I5,4X,'DS=',D15.8,2X,
& 'DF=',D15.8,/' F=',D16.9,2X,'DD1=',D14.7,2X,'DD2=',D14.7,
& 2X,'(FG)=',D13.6,/4(' U(',I2,')=',D12.5,1X))
END
SUBROUTINE GF(X,F,Li,N,Nres)
IMPLICIT NONE
REAL*8 F , FFUN , G , WORk , X
INTEGER ires , Li , N , NF , NG , Nres
DIMENSION X(1)
COMMON /EXTR / WORk(900) , G(100) , NF , NG
N = N + 1
Li = 0
IF ( Nres.GT.0 ) THEN
CALL GFUN(G,X)
NG = NG + 1
DO ires = 1 , Nres
IF ( G(ires).GT.0.D00 ) THEN
Li = ires
RETURN
ENDIF
ENDDO
ENDIF
F = FFUN(X)
NF = NF + 1
END
SUBROUTINE CPUSEC(SS)
IMPLICIT NONE
REAL*8 SS
REAL*4 S
S=SECOND()
SS=DBLE(SECNDS(0.0))*1000.D00
END
C###############################################################################
SUBROUTINE GFUN(G,X)
IMPLICIT NONE
REAL*8 G(100) , X(100)
G(1) = -X(2)
G(2) = X(1) + X(2) - 1.D00
END
REAL*8 FUNCTION FFUN(X)
IMPLICIT NONE
REAL*8 X(100)
ffun = 100.D00*(X(2)-X(1)**2)**2 + (1.D00-X(1))**2
END
C###############################################################################
C###############################################################################
C Von mir ab hier rein kopiert
DIMENSION U(2),DU(2),S(2,5)
EXTERNAL ROSE1 , ROSE2
U(1)=-2
U(2)=1.0
DU(1)=0.1
DU(2)=0.1
CALL EXTREM (ROSE1,2,U,DU,S,1.E-10,1.E-10,-40,FOPT,2)
U(1)=-2
U(2)=1.0
DU(1)=0.1
DU(2)=0.1
CALL EXTREM (ROSE2,2,U,DU,S,1.E-10,1.E-10,-40,FOPT,2)
STOP
END
SUBROUTINE ROSE1 (U,F,LI,N)
DIMENSION U(2)
F=100.*(U(2)-U(1)**2)**2*(1.-U(1))**2
N=N+1
RETURN
END
SUBROUTINE ROSE2 (X,F,LI,N)
DIMENSION X(2)
IF (X(2).LT.0.) LI=1
IF(LI.NE.0)RETURN
IF(X(1)+X(2).GT.1.) LI=2
IF=(LI.NE.0)RETURN
F=100.*(X(2)-X(1)**2)**2+(1.-X(1))**2
N=N+1
RETURN
END
ZSS.rar