1 |
|
2 |
c ================================================================== |
3 |
c |
4 |
c prgopti.F: Routines for doing an off-line optimization after the |
5 |
c ECCO forward and adjoint model have been run. |
6 |
c |
7 |
c main - Driver routine. |
8 |
c opti - Mid-level routine to do the spin up and spin down. |
9 |
c optimum - Routine that calls the minimization. |
10 |
c |
11 |
c Documentation: |
12 |
c |
13 |
c The collection of these routines originated mainly from Ralf |
14 |
c Giering. Patrick Heimbach improved and corrected considerable |
15 |
c parts of the original code. Christian Eckert contributed the |
16 |
c interface to the ECCO release of the MITgcmUV in order to get |
17 |
c the offline version going. |
18 |
c |
19 |
c How to use the off-line optimization. |
20 |
c |
21 |
c Doing an off-line optimization means that one alternately |
22 |
c calls the adjoint model and the optimization routines. |
23 |
c |
24 |
c The adjoint model yields at iteration i the cost function |
25 |
c value and the gradient of the cost function with respect to |
26 |
c the control variables. The optimization routines then use |
27 |
c this information to reduce the cost function and give a |
28 |
c new estimate of the control variables which can then be used |
29 |
c in the next cycle to yield a new cost function and the |
30 |
c corresponding gradient. |
31 |
c |
32 |
c started: Ralf Giering (lsoptv1) |
33 |
c |
34 |
c Patrick Heimbach heimbach@mit.edu 28-Feb-2000 |
35 |
c |
36 |
c - Corrected and restructured the original lsoptv1 |
37 |
c code. |
38 |
c |
39 |
c Christian Eckert eckert@mit.edu 15-Feb-2000 |
40 |
c |
41 |
c - Off-line capability and some cosmetic changes |
42 |
c of the optimization wrapper. |
43 |
c |
44 |
c changed: |
45 |
c |
46 |
c ================================================================== |
47 |
|
48 |
|
49 |
program optim_main |
50 |
|
51 |
c ================================================================== |
52 |
c PROGRAM optim_main |
53 |
c ================================================================== |
54 |
c |
55 |
c o Driver routine for the ECCO optimization package. |
56 |
c |
57 |
c started: Christian Eckert eckert@mit.edu 15-Feb-2000 |
58 |
c |
59 |
c changed: Christian Eckert eckert@mit.edu 10-Mar-2000 |
60 |
c |
61 |
c - Added ECCO layout. |
62 |
c |
63 |
c ================================================================== |
64 |
c SUBROUTINE |
65 |
c ================================================================== |
66 |
|
67 |
implicit none |
68 |
|
69 |
c == global variables == |
70 |
|
71 |
#include "blas1.h" |
72 |
|
73 |
c == routine arguments == |
74 |
|
75 |
c == local variables == |
76 |
|
77 |
integer nn |
78 |
|
79 |
c == end of interface == |
80 |
|
81 |
c-- Headline. |
82 |
print* |
83 |
print*,' ==================================================' |
84 |
print*,' Large Scale Optimization with off-line capability.' |
85 |
print*,' ==================================================' |
86 |
print* |
87 |
print*,' Version 2.1.0' |
88 |
print* |
89 |
|
90 |
c-- Get the number of control variables. |
91 |
call optim_numbmod( nn ) |
92 |
|
93 |
cph( |
94 |
print *, 'pathei: vor optim_sub' |
95 |
cph) |
96 |
c-- Call the subroutine. |
97 |
call optim_sub( nn ) |
98 |
|
99 |
c-- Succesful termination. |
100 |
print* |
101 |
print*,' ======================================' |
102 |
print*,' Large Scale Optimization run finished.' |
103 |
print*,' ======================================' |
104 |
print* |
105 |
|
106 |
end |
107 |
|
108 |
CStartOfInterface |
109 |
INTEGER FUNCTION IFNBLNK( string ) |
110 |
C /==========================================================\ |
111 |
C | FUNCTION IFNBLNK | |
112 |
C | o Find first non-blank in character string. | |
113 |
C \==========================================================/ |
114 |
IMPLICIT NONE |
115 |
C |
116 |
CHARACTER*(*) string |
117 |
CEndOfInterface |
118 |
C |
119 |
INTEGER L, LS |
120 |
C |
121 |
LS = LEN(string) |
122 |
IFNBLNK = 0 |
123 |
DO 10 L = 1, LS |
124 |
IF ( string(L:L) .EQ. ' ' ) GOTO 10 |
125 |
IFNBLNK = L |
126 |
GOTO 11 |
127 |
10 CONTINUE |
128 |
11 CONTINUE |
129 |
C |
130 |
RETURN |
131 |
END |
132 |
|
133 |
CStartOfInterface |
134 |
INTEGER FUNCTION ILNBLNK( string ) |
135 |
C /==========================================================\ |
136 |
C | FUNCTION ILNBLNK | |
137 |
C | o Find last non-blank in character string. | |
138 |
C \==========================================================/ |
139 |
IMPLICIT NONE |
140 |
CHARACTER*(*) string |
141 |
CEndOfInterface |
142 |
INTEGER L, LS |
143 |
C |
144 |
LS = LEN(string) |
145 |
ILNBLNK = LS |
146 |
DO 10 L = LS, 1, -1 |
147 |
IF ( string(L:L) .EQ. ' ' ) GOTO 10 |
148 |
ILNBLNK = L |
149 |
GOTO 11 |
150 |
10 CONTINUE |
151 |
11 CONTINUE |
152 |
C |
153 |
RETURN |
154 |
END |
155 |
|