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 coefils, ONLY: eignfnu, eignfnv, sddu, sddv, unsddu, unsddv
    USE comgeom, ONLY: xprimu, xprimv
    USE dimens_m, ONLY: iim
    use numer_rec_95, only: jacobi

    real, intent(out):: 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

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

    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, dv, eignfnv, nrot)
    CALL acc(eignfnv, d, iim)
    CALL eigen_sort(dv, eignfnv, iim, iim)

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