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

Annotation of /MITgcm/lsopt/lsupdxx.F

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

Revision 1.3 - (hide annotations) (download)
Fri Dec 6 01:42:25 2002 UTC (21 years, 4 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint51k_post, checkpoint47e_post, checkpoint47c_post, checkpoint50c_post, checkpoint48e_post, checkpoint50c_pre, checkpoint51o_pre, checkpoint51l_post, checkpoint48i_post, checkpoint50d_pre, checkpoint51, checkpoint50, checkpoint52, checkpoint50d_post, checkpoint50b_pre, checkpoint51f_post, checkpoint48b_post, checkpoint51d_post, checkpoint48c_pre, checkpoint47d_pre, checkpoint51t_post, checkpoint51n_post, checkpoint51s_post, checkpoint48d_pre, checkpoint51j_post, checkpoint47i_post, checkpoint51n_pre, checkpoint47d_post, checkpoint48d_post, checkpoint48f_post, checkpoint51l_pre, checkpoint48h_post, checkpoint51q_post, checkpoint51b_pre, checkpoint47g_post, checkpoint51h_pre, checkpoint48a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint47j_post, branch-exfmods-tag, branchpoint-genmake2, checkpoint51r_post, checkpoint48c_post, checkpoint51i_post, checkpoint51b_post, checkpoint51c_post, checkpoint50g_post, checkpoint52a_pre, checkpoint50h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51i_pre, checkpoint47f_post, checkpoint50e_post, checkpoint51e_post, checkpoint48, checkpoint49, checkpoint51o_post, checkpoint51f_pre, checkpoint48g_post, checkpoint47h_post, checkpoint52a_post, checkpoint51g_post, ecco_c52_e35, checkpoint50b_post, checkpoint51m_post, checkpoint51a_post, checkpoint51p_post, checkpoint51u_post
Branch point for: branch-exfmods-curt, branch-genmake2, branch-nonh, tg2-branch, checkpoint51n_branch
Changes since 1.2: +3 -3 lines 
o lsopt:
  changed BLAS calls from single prec. (SDOT, SNRM2,SSCAL)
  to double prec. (DDOT, DNRM2, DSCAL)
  for compatibility with IBM SP3/SP4
o optim:
  bringing optim_readdata/optim_writedata formats up-to-date
  with latest ctrl_pack/ctrl_unpack formats.
NB: need to be merged in release1 and ecco-branch
1 heimbach 1.2
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 heimbach 1.3 double precision DDOT
50     external DDOT
51 heimbach 1.2
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 heimbach 1.3 dotdg = DDOT( nn, dd, 1, gg, 1 )
103 heimbach 1.2 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