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	guez	113	module inifgn_m
2	guez	3
3	guez	140	use dimens_m, only: iim
4
5	guez	113	IMPLICIT NONE
6	guez	3
7	guez	140	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	guez	143	! eigenfunctions of the discrete laplacian
14	guez	140
15	guez	113	contains
16	guez	3
17	guez	113	SUBROUTINE inifgn(dv)
18	guez	3
19	guez	113	! From LMDZ4/libf/filtrez/inifgn.F, v 1.1.1.1 2004/05/19 12:53:09
20	guez	3
21	guez	143	! H. Upadyaya, O. Sharma
22	guez	3
23	guez	143	use acc_m, only: acc
24	guez	113	USE dimens_m, ONLY: iim
25	guez	139	USE dynetat0_m, ONLY: xprimu, xprimv
26	guez	140	use nr_util, only: pi
27	guez	143	use numer_rec_95, only: jacobi, eigsrt
28	guez	3
29	guez	143	real, intent(out):: dv(:) ! (iim)
30	guez	81
31	guez	113	! Local:
32			REAL vec(iim, iim), vec1(iim, iim)
33			REAL du(iim)
34	guez	140	INTEGER i, j, k, nrot
35	guez	81
36	guez	113	!----------------------------------------------------------------
37	guez	81
38	guez	140	sddv = sqrt(xprimv(:iim))
39			sddu = sqrt(xprimu(:iim))
40			unsddu = 1. / sddu
41			unsddv = 1. / sddv
42	guez	81
43	guez	113	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	guez	81
52	guez	140	eignfnv(1, 1) = - 1.
53	guez	113	eignfnv(iim, 1) = 1.
54	guez	140	DO i = 1, iim - 1
55			eignfnv(i+1, i+1) = - 1.
56	guez	113	eignfnv(i, i+1) = 1.
57	guez	81	END DO
58	guez	140
59	guez	113	DO j = 1, iim
60			DO i = 1, iim
61	guez	140	eignfnv(i, j) = eignfnv(i, j) / (sddu(i) * sddv(j))
62	guez	113	END DO
63	guez	81	END DO
64	guez	140
65	guez	113	DO j = 1, iim
66			DO i = 1, iim
67	guez	140	eignfnu(i, j) = - eignfnv(j, i)
68	guez	113	END DO
69			END DO
70	guez	81
71	guez	113	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	guez	140	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	guez	113	END DO
79			END DO
80	guez	81	END DO
81
82	guez	132	CALL jacobi(vec, dv, eignfnv, nrot)
83	guez	143	CALL acc(eignfnv)
84			CALL eigsrt(dv, eignfnv)
85	guez	81
86	guez	132	CALL jacobi(vec1, du, eignfnu, nrot)
87	guez	143	CALL acc(eignfnu)
88			CALL eigsrt(du, eignfnu)
89	guez	81
90	guez	113	END SUBROUTINE inifgn
91	guez	81
92	guez	113	end module inifgn_m