trunk/filtrez/inifgn.f

module inifgn_m

  use dimens_m, only: iim

  IMPLICIT NONE

  private iim

  real sddu(iim), sddv(iim) ! SQRT(dx)
  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)

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

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

    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)
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)
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	sddv = sqrt(xprimv(:iim))
39	sddu = sqrt(xprimu(:iim))
40	unsddu = 1. / sddu
41	unsddv = 1. / sddv
42
43	DO j = 1, iim
44	DO i = 1, iim
45	vec(i, j) = 0.
46	vec1(i, j) = 0.
47	eignfnv(i, j) = 0.
48	eignfnu(i, j) = 0.
49	END DO
50	END DO
51
52	eignfnv(1, 1) = - 1.
53	eignfnv(iim, 1) = 1.
54	DO i = 1, iim - 1
55	eignfnv(i+1, i+1) = - 1.
56	eignfnv(i, i+1) = 1.
57	END DO
58
59	DO j = 1, iim
60	DO i = 1, iim
61	eignfnv(i, j) = eignfnv(i, j) / (sddu(i) * sddv(j))
62	END DO
63	END DO
64
65	DO j = 1, iim
66	DO i = 1, iim
67	eignfnu(i, j) = - eignfnv(j, i)
68	END DO
69	END DO
70
71	DO j = 1, iim
72	DO i = 1, iim
73	vec(i, j) = 0.0
74	vec1(i, j) = 0.0
75	DO k = 1, iim
76	vec(i, j) = vec(i, j) + eignfnu(i, k) * eignfnv(k, j)
77	vec1(i, j) = vec1(i, j) + eignfnv(i, k) * eignfnu(k, j)
78	END DO
79	END DO
80	END DO
81
82	CALL jacobi(vec, dv, eignfnv, nrot)
83	CALL acc(eignfnv)
84	CALL eigsrt(dv, eignfnv)
85
86	CALL jacobi(vec1, du, eignfnu, nrot)
87	CALL acc(eignfnu)
88	CALL eigsrt(du, eignfnu)
89
90	END SUBROUTINE inifgn
91
92	end module inifgn_m