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	guez	113	module inifgn_m
2	guez	3
3	guez	113	IMPLICIT NONE
4	guez	3
5	guez	113	contains
6	guez	3
7	guez	113	SUBROUTINE inifgn(dv)
8	guez	3
9	guez	113	! From LMDZ4/libf/filtrez/inifgn.F, v 1.1.1.1 2004/05/19 12:53:09
10	guez	3
11	guez	113	! H.Upadyaya, O.Sharma
12	guez	3
13	guez	132	USE coefils, ONLY: eignfnu, eignfnv, sddu, sddv, unsddu, unsddv
14			USE comgeom, ONLY: xprimu, xprimv
15	guez	113	USE dimens_m, ONLY: iim
16	guez	132	use numer_rec_95, only: jacobi
17	guez	3
18	guez	132	real, intent(out):: dv(iim)
19	guez	81
20	guez	113	! 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	guez	81
27	guez	132	EXTERNAL acc
28	guez	81
29	guez	113	!----------------------------------------------------------------
30	guez	81
31	guez	113	imm1 = iim - 1
32			pi = 2.*asin(1.)
33	guez	81
34	guez	113	DO i = 1, iim
35	guez	121	sddv(i) = sqrt(xprimv(i))
36			sddu(i) = sqrt(xprimu(i))
37	guez	113	unsddu(i) = 1./sddu(i)
38			unsddv(i) = 1./sddv(i)
39	guez	81	END DO
40
41	guez	113	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	guez	81
50	guez	113	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	guez	81	END DO
56	guez	113	DO j = 1, iim
57			DO i = 1, iim
58			eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))
59			END DO
60	guez	81	END DO
61	guez	113	DO j = 1, iim
62			DO i = 1, iim
63			eignfnu(i, j) = -eignfnv(j, i)
64			END DO
65			END DO
66	guez	81
67	guez	113	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	guez	81	END DO
77
78	guez	132	CALL jacobi(vec, dv, eignfnv, nrot)
79	guez	113	CALL acc(eignfnv, d, iim)
80			CALL eigen_sort(dv, eignfnv, iim, iim)
81	guez	81
82	guez	132	CALL jacobi(vec1, du, eignfnu, nrot)
83	guez	113	CALL acc(eignfnu, d, iim)
84			CALL eigen_sort(du, eignfnu, iim, iim)
85	guez	81
86	guez	113	END SUBROUTINE inifgn
87	guez	81
88	guez	113	end module inifgn_m