/[MITgcm]/MITgcm/lsopt/lsupdxx.F
ViewVC logotype

Contents of /MITgcm/lsopt/lsupdxx.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.4 - (show annotations) (download)
Wed Nov 19 19:07:02 2003 UTC (19 years ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint57m_post, checkpoint52l_pre, checkpoint62u, hrcube4, hrcube5, checkpoint57g_pre, checkpoint62t, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint52d_pre, checkpoint57g_post, checkpoint56b_post, checkpoint57y_post, checkpoint52j_pre, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint54d_post, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint54e_post, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62c, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint52k_post, checkpoint59, checkpoint58, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint53, checkpoint58f_post, checkpoint52f_post, checkpoint57n_post, checkpoint58d_post, checkpoint62s, checkpoint58a_post, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint57z_post, checkpoint54f_post, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint58t_post, checkpoint55i_post, checkpoint58m_post, checkpoint57l_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint57t_post, checkpoint55c_post, checkpoint63g, checkpoint52e_pre, checkpoint57v_post, checkpoint57f_post, checkpoint52e_post, checkpoint53d_post, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint57a_post, checkpoint57h_pre, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint52b_pre, checkpoint54b_post, checkpoint58w_post, checkpoint57h_post, checkpoint52m_post, checkpoint57y_pre, checkpoint55g_post, checkpoint52b_post, checkpoint52c_post, checkpoint58o_post, checkpoint57c_post, checkpoint58p_post, checkpoint58q_post, checkpoint52f_pre, checkpoint55d_post, checkpoint58e_post, checkpoint54a_pre, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint53c_post, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint55d_pre, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint58n_post, checkpoint57e_post, checkpoint55b_post, checkpoint53a_post, checkpoint65o, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint52d_post, checkpoint53g_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint58k_post, checkpoint62b, checkpoint58v_post, checkpoint52i_post, checkpoint52h_pre, checkpoint56a_post, checkpoint64y, checkpoint64x, checkpoint58l_post, checkpoint64z, checkpoint53f_post, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint57h_done, checkpoint52j_post, checkpoint57j_post, checkpoint57f_pre, checkpoint61f, checkpoint58g_post, branch-netcdf, checkpoint52l_post, checkpoint58x_post, checkpoint61n, checkpoint52n_post, checkpoint53b_pre, checkpoint59j, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint61q, checkpoint57k_post, checkpoint53b_post, checkpoint57w_post, checkpoint61e, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint53d_pre, checkpoint58s_post, checkpoint55e_post, checkpoint61g, checkpoint61d, checkpoint54c_post, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y, HEAD
Branch point for: netcdf-sm0
Changes since 1.3: +1 -1 lines
Bringing up-to-date with latest ctrl and IRIX64

1
2 subroutine lsupdxx(
3 & nn, ifail, lphprint
4 & , jmin, jmax, nupdate
5 & , ff, fmin, fold, gnorm0, dotdg
6 & , gg, dd, xx, xdiff
7 & , tmin, tmax, tact, epsx
8 & )
9
10 c ==================================================================
11 c SUBROUTINE lsupdxx
12 c ==================================================================
13 c
14 c o conceived for variable online/offline version
15 c computes - new descent direction dd based on latest
16 c available gradient
17 c - new tact based on new dd
18 c - new control vector xx needed for offline run
19 c
20 c o started: Patrick Heimbach, MIT/EAPS
21 c 29-Feb-2000:
22 c
23 c o Version 2.1.0, 02-Mar-2000: Patrick Heimbach, MIT/EAPS
24 c
25 c ==================================================================
26 c SUBROUTINE lsupdxx
27 c ==================================================================
28 c
29
30 #include "blas1.h"
31
32 implicit none
33
34 c-----------------------------------------
35 c declare arguments
36 c-----------------------------------------
37 integer nn, jmin, jmax, nupdate, ifail
38 double precision ff, fmin, fold, gnorm0, dotdg
39 double precision gg(nn), dd(nn), xx(nn), xdiff(nn)
40 double precision tmin, tmax, tact, epsx
41 logical lphprint
42
43 c-----------------------------------------
44 C declare local variables
45 c-----------------------------------------
46 integer i
47 double precision fdiff, preco
48
49 double precision DDOT
50 external DDOT
51
52 c ==================================================================
53
54 c-----------------------------------------
55 c use Fletchers scaling
56 c and initialize diagional to 1.
57 c-----------------------------------------
58 c
59 if ( ( jmax .eq. 0 ) .or. (nupdate .eq. 0 ) ) then
60
61 if (jmax .eq. 0) then
62 fold = fmin
63 if (lphprint)
64 & print *, 'pathei-lsopt: using fold = fmin = ', fmin
65 end if
66 fdiff = fold - ff
67 if (jmax .eq. 0) fdiff = ABS(fdiff)
68
69 preco = 2. * fdiff / (gnorm0*gnorm0)
70 do i = 1, nn
71 dd(i) = -gg(i)*preco
72 end do
73
74 if (lphprint)
75 & print *, 'pathei-lsopt: first estimate of dd via ',
76 & 'fold - ff'
77
78 c-----------------------------------------
79 c use the matrix stored in [diag]
80 c and the (y,s) pairs
81 c-----------------------------------------
82
83 else
84
85 do i = 1, nn
86 dd(i) = -gg(i)
87 end do
88
89 if (jmax .gt. 0) then
90 call hessupd( nn, nupdate, dd, jmin, jmax, xdiff,
91 & lphprint )
92 else
93 if (lphprint)
94 & print *, 'pathei-lsopt: no hessupd for first optim.'
95 end if
96
97 endif
98
99 c-----------------------------------------
100 c check whether new direction is a descent one
101 c-----------------------------------------
102 dotdg = DDOT( nn, dd, 1, gg, 1 )
103 if (dotdg .ge. 0.0) then
104 ifail = 4
105 goto 999
106 end if
107
108 c----------------------------------
109 c declare arguments
110 c----------------------------------
111
112 tmin = 0.
113 do i = 1, nn
114 tmin = max( tmin, abs(dd(i)) )
115 end do
116 tmin = epsx/tmin
117
118 c----------------------------------
119 c make sure that t is between
120 c tmin and tmax
121 c----------------------------------
122
123 tact = 1.0
124 tmax = 1.0e+10
125 if (tact.le.tmin) then
126 tact = tmin
127 if (tact.gt.tmax) then
128 tmin = tmax
129 endif
130 endif
131
132 if (tact .gt. tmax) then
133 tact = tmax
134 ifail = 7
135 endif
136
137 c----------------------------------
138 c compute new x
139 c----------------------------------
140 do i = 1, nn
141 xdiff(i) = xx(i) + tact*dd(i)
142 end do
143
144 c----------------------------------
145 c save new x to file for offline version
146 c----------------------------------
147
148 999 continue
149
150 return
151
152 end

  ViewVC Help
Powered by ViewVC 1.1.22