MITgcm/lsopt/dgscale.F


      subroutine dgscale( nn, gold, xdiff, diag, rmin )


c     ==================================================================
c     SUBROUTINE dgscale
c     ==================================================================
c
c     o computes new preconditioner and writes it to OPWARMD
c
c     o started: ??? not reproducible
c
c     o Version: 2.1.0, 02-Mar-2000: Patrick Heimbach, MIT/EAPS
c
c     ==================================================================
c     SUBROUTINE dgscale
c     ==================================================================

      implicit none

#include "blas1.h"

      integer nn
      double precision    gold(nn), xdiff(nn), diag(nn)

      integer i
      double precision    r1, rmin, den


c-----------------------------------------
c read diagonal
c-----------------------------------------
      call dostore( nn, diag, .false., 3 )

      r1 = 0.
      do i = 1, nn
        r1 = r1 + gold(i)*gold(i)*diag(i)
      end do
      r1 = 1.0 / r1

      call SSCAL( nn, r1, diag, 1 )

c-----------------------------------------
c update the diagonal
c (gg is used as an auxiliary vector)
c-----------------------------------------

      den = 0.0

      do i = 1, nn
cph(
         if (diag(i).LE.0) then
            print *, 'pathei-lsopt: in dgscale; diag = 0 for i=', i
            diag(i) = rmin
         end if
cph)
         den = den + xdiff(i)*xdiff(i) / diag(i)
      end do

      do i = 1, nn
         diag(i) = 1./
     $        (1./diag(i)+gold(i)**2-(xdiff(i)/diag(i))**2/den)
         if (diag(i).le.0.) then
            diag(i) = rmin
         endif
      end do

c-----------------------------------------
c write diagonal
c-----------------------------------------
      call dostore( nn, diag, .true., 3 )

      return
      end
1
2	subroutine dgscale( nn, gold, xdiff, diag, rmin )
3
4
5	c ==================================================================
6	c SUBROUTINE dgscale
7	c ==================================================================
8	c
9	c o computes new preconditioner and writes it to OPWARMD
10	c
11	c o started: ??? not reproducible
12	c
13	c o Version: 2.1.0, 02-Mar-2000: Patrick Heimbach, MIT/EAPS
14	c
15	c ==================================================================
16	c SUBROUTINE dgscale
17	c ==================================================================
18
19	implicit none
20
21	#include "blas1.h"
22
23	integer nn
24	double precision gold(nn), xdiff(nn), diag(nn)
25
26	integer i
27	double precision r1, rmin, den
28
29
30	c-----------------------------------------
31	c read diagonal
32	c-----------------------------------------
33	call dostore( nn, diag, .false., 3 )
34
35	r1 = 0.
36	do i = 1, nn
37	r1 = r1 + gold(i)gold(i)diag(i)
38	end do
39	r1 = 1.0 / r1
40
41	call SSCAL( nn, r1, diag, 1 )
42
43	c-----------------------------------------
44	c update the diagonal
45	c (gg is used as an auxiliary vector)
46	c-----------------------------------------
47
48	den = 0.0
49
50	do i = 1, nn
51	cph(
52	if (diag(i).LE.0) then
53	print *, 'pathei-lsopt: in dgscale; diag = 0 for i=', i
54	diag(i) = rmin
55	end if
56	cph)
57	den = den + xdiff(i)*xdiff(i) / diag(i)
58	end do
59
60	do i = 1, nn
61	diag(i) = 1./
62	$ (1./diag(i)+gold(i)2-(xdiff(i)/diag(i))2/den)
63	if (diag(i).le.0.) then
64	diag(i) = rmin
65	endif
66	end do
67
68	c-----------------------------------------
69	c write diagonal
70	c-----------------------------------------
71	call dostore( nn, diag, .true., 3 )
72
73	return
74	end