trunk/filtrez/inifgn.f

module inifgn_m

  IMPLICIT NONE

contains

  SUBROUTINE inifgn(dv)

    ! From LMDZ4/libf/filtrez/inifgn.F, v 1.1.1.1 2004/05/19 12:53:09

    ! H.Upadyaya, O.Sharma 

    USE dimens_m, ONLY: iim
    USE comgeom, ONLY: xprimu, xprimv
    USE coefils, ONLY: eignfnu, eignfnv, sddu, sddv, unsddu, unsddv

    real dv(iim)

    ! Local:
    REAL vec(iim, iim), vec1(iim, iim)
    REAL du(iim)
    real d(iim)
    REAL pi
    INTEGER i, j, k, imm1, nrot

    EXTERNAL acc, jacobi

    !----------------------------------------------------------------

    imm1 = iim - 1
    pi = 2.*asin(1.)

    DO i = 1, iim
       sddv(i) = sqrt(xprimv(i))
       sddu(i) = sqrt(xprimu(i))
       unsddu(i) = 1./sddu(i)
       unsddv(i) = 1./sddv(i)
    END DO

    DO j = 1, iim
       DO i = 1, iim
          vec(i, j) = 0.
          vec1(i, j) = 0.
          eignfnv(i, j) = 0.
          eignfnu(i, j) = 0.
       END DO
    END DO

    eignfnv(1, 1) = -1.
    eignfnv(iim, 1) = 1.
    DO i = 1, imm1
       eignfnv(i+1, i+1) = -1.
       eignfnv(i, i+1) = 1.
    END DO
    DO j = 1, iim
       DO i = 1, iim
          eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))
       END DO
    END DO
    DO j = 1, iim
       DO i = 1, iim
          eignfnu(i, j) = -eignfnv(j, i)
       END DO
    END DO

    DO j = 1, iim
       DO i = 1, iim
          vec(i, j) = 0.0
          vec1(i, j) = 0.0
          DO k = 1, iim
             vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)
             vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)
          END DO
       END DO
    END DO

    CALL jacobi(vec, iim, iim, dv, eignfnv, nrot)
    CALL acc(eignfnv, d, iim)
    CALL eigen_sort(dv, eignfnv, iim, iim)

    CALL jacobi(vec1, iim, iim, du, eignfnu, nrot)
    CALL acc(eignfnu, d, iim)
    CALL eigen_sort(du, eignfnu, iim, iim)

  END SUBROUTINE inifgn

end module inifgn_m
1	module inifgn_m
2
3	IMPLICIT NONE
4
5	contains
6
7	SUBROUTINE inifgn(dv)
8
9	! From LMDZ4/libf/filtrez/inifgn.F, v 1.1.1.1 2004/05/19 12:53:09
10
11	! H.Upadyaya, O.Sharma
12
13	USE dimens_m, ONLY: iim
14	USE comgeom, ONLY: xprimu, xprimv
15	USE coefils, ONLY: eignfnu, eignfnv, sddu, sddv, unsddu, unsddv
16
17	real dv(iim)
18
19	! Local:
20	REAL vec(iim, iim), vec1(iim, iim)
21	REAL du(iim)
22	real d(iim)
23	REAL pi
24	INTEGER i, j, k, imm1, nrot
25
26	EXTERNAL acc, jacobi
27
28	!----------------------------------------------------------------
29
30	imm1 = iim - 1
31	pi = 2.*asin(1.)
32
33	DO i = 1, iim
34	sddv(i) = sqrt(xprimv(i))
35	sddu(i) = sqrt(xprimu(i))
36	unsddu(i) = 1./sddu(i)
37	unsddv(i) = 1./sddv(i)
38	END DO
39
40	DO j = 1, iim
41	DO i = 1, iim
42	vec(i, j) = 0.
43	vec1(i, j) = 0.
44	eignfnv(i, j) = 0.
45	eignfnu(i, j) = 0.
46	END DO
47	END DO
48
49	eignfnv(1, 1) = -1.
50	eignfnv(iim, 1) = 1.
51	DO i = 1, imm1
52	eignfnv(i+1, i+1) = -1.
53	eignfnv(i, i+1) = 1.
54	END DO
55	DO j = 1, iim
56	DO i = 1, iim
57	eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))
58	END DO
59	END DO
60	DO j = 1, iim
61	DO i = 1, iim
62	eignfnu(i, j) = -eignfnv(j, i)
63	END DO
64	END DO
65
66	DO j = 1, iim
67	DO i = 1, iim
68	vec(i, j) = 0.0
69	vec1(i, j) = 0.0
70	DO k = 1, iim
71	vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)
72	vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)
73	END DO
74	END DO
75	END DO
76
77	CALL jacobi(vec, iim, iim, dv, eignfnv, nrot)
78	CALL acc(eignfnv, d, iim)
79	CALL eigen_sort(dv, eignfnv, iim, iim)
80
81	CALL jacobi(vec1, iim, iim, du, eignfnu, nrot)
82	CALL acc(eignfnu, d, iim)
83	CALL eigen_sort(du, eignfnu, iim, iim)
84
85	END SUBROUTINE inifgn
86
87	end module inifgn_m