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 dlonu(iim), dlonv(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
       dlonu(i) = xprimu(i)
       dlonv(i) = xprimv(i)
    END DO

    DO i = 1, iim
       sddv(i) = sqrt(dlonv(i))
       sddu(i) = sqrt(dlonu(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 dlonu(iim), dlonv(iim)
22	REAL du(iim)
23	real d(iim)
24	REAL pi
25	INTEGER i, j, k, imm1, nrot
26
27	EXTERNAL acc, jacobi
28
29	!----------------------------------------------------------------
30
31	imm1 = iim - 1
32	pi = 2.*asin(1.)
33
34	DO i = 1, iim
35	dlonu(i) = xprimu(i)
36	dlonv(i) = xprimv(i)
37	END DO
38
39	DO i = 1, iim
40	sddv(i) = sqrt(dlonv(i))
41	sddu(i) = sqrt(dlonu(i))
42	unsddu(i) = 1./sddu(i)
43	unsddv(i) = 1./sddv(i)
44	END DO
45
46	DO j = 1, iim
47	DO i = 1, iim
48	vec(i, j) = 0.
49	vec1(i, j) = 0.
50	eignfnv(i, j) = 0.
51	eignfnu(i, j) = 0.
52	END DO
53	END DO
54
55	eignfnv(1, 1) = -1.
56	eignfnv(iim, 1) = 1.
57	DO i = 1, imm1
58	eignfnv(i+1, i+1) = -1.
59	eignfnv(i, i+1) = 1.
60	END DO
61	DO j = 1, iim
62	DO i = 1, iim
63	eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))
64	END DO
65	END DO
66	DO j = 1, iim
67	DO i = 1, iim
68	eignfnu(i, j) = -eignfnv(j, i)
69	END DO
70	END DO
71
72	DO j = 1, iim
73	DO i = 1, iim
74	vec(i, j) = 0.0
75	vec1(i, j) = 0.0
76	DO k = 1, iim
77	vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)
78	vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)
79	END DO
80	END DO
81	END DO
82
83	CALL jacobi(vec, iim, iim, dv, eignfnv, nrot)
84	CALL acc(eignfnv, d, iim)
85	CALL eigen_sort(dv, eignfnv, iim, iim)
86
87	CALL jacobi(vec1, iim, iim, du, eignfnu, nrot)
88	CALL acc(eignfnu, d, iim)
89	CALL eigen_sort(du, eignfnu, iim, iim)
90
91	END SUBROUTINE inifgn
92
93	end module inifgn_m