trunk/filtrez/inifgn.f

module inifgn_m

  use dimens_m, only: iim

  IMPLICIT NONE

  private iim

  real sddu(iim), sddv(iim) ! SQRT(dx / di)
  real unsddu(iim), unsddv(iim)

  real eignfnu(iim, iim), eignfnv(iim, iim)
  ! eigenfunctions of the discrete laplacian

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 acc_m, only: acc 
    USE dimens_m, ONLY: iim
    USE dynetat0_m, ONLY: xprimu, xprimv
    use nr_util, only: pi
    use numer_rec_95, only: jacobi, eigsrt

    real, intent(out):: dv(:) ! (iim) eigenvalues sorted in descending order

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

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

    print *, "Call sequence information: inifgn"

    sddv = sqrt(xprimv(:iim))
    sddu = sqrt(xprimu(:iim))
    unsddu = 1. / sddu
    unsddv = 1. / sddv

    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, iim - 1
       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)
    CALL eigsrt(dv, eignfnv)

    CALL jacobi(vec1, du, eignfnu, nrot)
    CALL acc(eignfnu)
    CALL eigsrt(du, eignfnu)

  END SUBROUTINE inifgn

end module inifgn_m
1	module inifgn_m
2
3	use dimens_m, only: iim
4
5	IMPLICIT NONE
6
7	private iim
8
9	real sddu(iim), sddv(iim) ! SQRT(dx / di)
10	real unsddu(iim), unsddv(iim)
11
12	real eignfnu(iim, iim), eignfnv(iim, iim)
13	! eigenfunctions of the discrete laplacian
14
15	contains
16
17	SUBROUTINE inifgn(dv)
18
19	! From LMDZ4/libf/filtrez/inifgn.F, v 1.1.1.1 2004/05/19 12:53:09
20
21	! H. Upadyaya, O. Sharma
22
23	use acc_m, only: acc
24	USE dimens_m, ONLY: iim
25	USE dynetat0_m, ONLY: xprimu, xprimv
26	use nr_util, only: pi
27	use numer_rec_95, only: jacobi, eigsrt
28
29	real, intent(out):: dv(:) ! (iim) eigenvalues sorted in descending order
30
31	! Local:
32	REAL vec(iim, iim), vec1(iim, iim)
33	REAL du(iim)
34	INTEGER i, j, k, nrot
35
36	!----------------------------------------------------------------
37
38	print *, "Call sequence information: inifgn"
39
40	sddv = sqrt(xprimv(:iim))
41	sddu = sqrt(xprimu(:iim))
42	unsddu = 1. / sddu
43	unsddv = 1. / sddv
44
45	DO j = 1, iim
46	DO i = 1, iim
47	vec(i, j) = 0.
48	vec1(i, j) = 0.
49	eignfnv(i, j) = 0.
50	eignfnu(i, j) = 0.
51	END DO
52	END DO
53
54	eignfnv(1, 1) = - 1.
55	eignfnv(iim, 1) = 1.
56	DO i = 1, iim - 1
57	eignfnv(i+1, i+1) = - 1.
58	eignfnv(i, i+1) = 1.
59	END DO
60
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
67	DO j = 1, iim
68	DO i = 1, iim
69	eignfnu(i, j) = - eignfnv(j, i)
70	END DO
71	END DO
72
73	DO j = 1, iim
74	DO i = 1, iim
75	vec(i, j) = 0.0
76	vec1(i, j) = 0.0
77	DO k = 1, iim
78	vec(i, j) = vec(i, j) + eignfnu(i, k) * eignfnv(k, j)
79	vec1(i, j) = vec1(i, j) + eignfnv(i, k) * eignfnu(k, j)
80	END DO
81	END DO
82	END DO
83
84	CALL jacobi(vec, dv, eignfnv, nrot)
85	CALL acc(eignfnv)
86	CALL eigsrt(dv, eignfnv)
87
88	CALL jacobi(vec1, du, eignfnu, nrot)
89	CALL acc(eignfnu)
90	CALL eigsrt(du, eignfnu)
91
92	END SUBROUTINE inifgn
93
94	end module inifgn_m