libf/filtrez/inifgn.f

!
! $Header: /home/cvsroot/LMDZ4/libf/filtrez/inifgn.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
!
      SUBROUTINE inifgn(dv)
c  
c    ...  H.Upadyaya , O.Sharma  ... 
c
      use dimens_m
      use paramet_m
      use comgeom
      use serre
            use coefils
      IMPLICIT NONE
c

c
      REAL vec(iim,iim),vec1(iim,iim)
      REAL dlonu(iim),dlonv(iim)
      REAL du(iim),dv(iim),d(iim)
      REAL pi
      INTEGER i,j,k,imm1,nrot
C
c
      EXTERNAL SSUM, acc, jacobi
CC      EXTERNAL eigen
      REAL SSUM
c

      imm1  = iim -1
      pi = 2.* ASIN(1.)
C
      DO 5 i=1,iim
       dlonu(i)=  xprimu( i )
       dlonv(i)=  xprimv( i )
   5  CONTINUE

      DO 12 i=1,iim
      sddv(i)   = SQRT(dlonv(i))
      sddu(i)   = SQRT(dlonu(i))
      unsddu(i) = 1./sddu(i)
      unsddv(i) = 1./sddv(i)
  12  CONTINUE
C
      DO 17 j=1,iim
      DO 17 i=1,iim
      vec(i,j)     = 0.
      vec1(i,j)    = 0.
      eignfnv(i,j) = 0.
      eignfnu(i,j) = 0.
  17  CONTINUE
c
c
      eignfnv(1,1)    = -1.
      eignfnv(iim,1)  =  1.
      DO 20 i=1,imm1
      eignfnv(i+1,i+1)= -1.
      eignfnv(i,i+1)  =  1.
  20  CONTINUE
      DO 25 j=1,iim
      DO 25 i=1,iim
      eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
  25  CONTINUE
      DO 30 j=1,iim
      DO 30 i=1,iim
      eignfnu(i,j) = -eignfnv(j,i)
  30  CONTINUE
c
      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)
       ENDDO
      ENDDO
      ENDDO

c
      CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
      CALL acc(eignfnv,d,iim)
      CALL eigen_sort(dv,eignfnv,iim,iim)
c
      CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
      CALL acc(eignfnu,d,iim)
      CALL eigen_sort(du,eignfnu,iim,iim)

cc   ancienne version avec appels IMSL
c
c     CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
c     CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
c     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
c     CALL acc(eignfnv,d,iim)
c     CALL eigen(eignfnv,dv)
c
c     CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
c     CALL acc(eignfnu,d,iim)
c     CALL eigen(eignfnu,du)

      RETURN
      END

1	!
2	! $Header: /home/cvsroot/LMDZ4/libf/filtrez/inifgn.F,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
3	!
4	SUBROUTINE inifgn(dv)
5	c
6	c ... H.Upadyaya , O.Sharma ...
7	c
8	use dimens_m
9	use paramet_m
10	use comgeom
11	use serre
12	use coefils
13	IMPLICIT NONE
14	c
15
16	c
17	REAL vec(iim,iim),vec1(iim,iim)
18	REAL dlonu(iim),dlonv(iim)
19	REAL du(iim),dv(iim),d(iim)
20	REAL pi
21	INTEGER i,j,k,imm1,nrot
22	C
23	c
24	EXTERNAL SSUM, acc, jacobi
25	CC EXTERNAL eigen
26	REAL SSUM
27	c
28
29	imm1 = iim -1
30	pi = 2.* ASIN(1.)
31	C
32	DO 5 i=1,iim
33	dlonu(i)= xprimu( i )
34	dlonv(i)= xprimv( i )
35	5 CONTINUE
36
37	DO 12 i=1,iim
38	sddv(i) = SQRT(dlonv(i))
39	sddu(i) = SQRT(dlonu(i))
40	unsddu(i) = 1./sddu(i)
41	unsddv(i) = 1./sddv(i)
42	12 CONTINUE
43	C
44	DO 17 j=1,iim
45	DO 17 i=1,iim
46	vec(i,j) = 0.
47	vec1(i,j) = 0.
48	eignfnv(i,j) = 0.
49	eignfnu(i,j) = 0.
50	17 CONTINUE
51	c
52	c
53	eignfnv(1,1) = -1.
54	eignfnv(iim,1) = 1.
55	DO 20 i=1,imm1
56	eignfnv(i+1,i+1)= -1.
57	eignfnv(i,i+1) = 1.
58	20 CONTINUE
59	DO 25 j=1,iim
60	DO 25 i=1,iim
61	eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
62	25 CONTINUE
63	DO 30 j=1,iim
64	DO 30 i=1,iim
65	eignfnu(i,j) = -eignfnv(j,i)
66	30 CONTINUE
67	c
68	DO j = 1, iim
69	DO i = 1, iim
70	vec (i,j) = 0.0
71	vec1(i,j) = 0.0
72	DO k = 1, iim
73	vec (i,j) = vec(i,j) + eignfnu(i,k) * eignfnv(k,j)
74	vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
75	ENDDO
76	ENDDO
77	ENDDO
78
79	c
80	CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
81	CALL acc(eignfnv,d,iim)
82	CALL eigen_sort(dv,eignfnv,iim,iim)
83	c
84	CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
85	CALL acc(eignfnu,d,iim)
86	CALL eigen_sort(du,eignfnu,iim,iim)
87
88	cc ancienne version avec appels IMSL
89	c
90	c CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
91	c CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
92	c CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
93	c CALL acc(eignfnv,d,iim)
94	c CALL eigen(eignfnv,dv)
95	c
96	c CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
97	c CALL acc(eignfnu,d,iim)
98	c CALL eigen(eignfnu,du)
99
100	RETURN
101	END
102