My Project
 All Classes Files Functions Variables Macros
inifgn.F
Go to the documentation of this file.
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  IMPLICIT NONE
9 c
10 #include "dimensions.h"
11 #include "paramet.h"
12 #include "comgeom.h"
13 #include "serre.h"
14 
15 c
16  REAL vec(iim,iim),vec1(iim,iim)
17  REAL dlonu(iim),dlonv(iim)
18  REAL du(iim),dv(iim),d(iim)
19  REAL pi
20  INTEGER i,j,k,imm1,nrot
21 C
22 #include "coefils.h"
23 c
24  EXTERNAL ssum, acc,eigen,jacobi
25  REAL ssum
26 c
27 
28  imm1 = iim -1
29  pi = 2.* asin(1.)
30 C
31  DO 5 i=1,iim
32  dlonu(i)= xprimu( i )
33  dlonv(i)= xprimv( i )
34  5 CONTINUE
35 
36  DO 12 i=1,iim
37  sddv(i) = sqrt(dlonv(i))
38  sddu(i) = sqrt(dlonu(i))
39  unsddu(i) = 1./sddu(i)
40  unsddv(i) = 1./sddv(i)
41  12 CONTINUE
42 C
43  DO 17 j=1,iim
44  DO 17 i=1,iim
45  vec(i,j) = 0.
46  vec1(i,j) = 0.
47  eignfnv(i,j) = 0.
48  eignfnu(i,j) = 0.
49  17 CONTINUE
50 c
51 c
52  eignfnv(1,1) = -1.
53  eignfnv(iim,1) = 1.
54  DO 20 i=1,imm1
55  eignfnv(i+1,i+1)= -1.
56  eignfnv(i,i+1) = 1.
57  20 CONTINUE
58  DO 25 j=1,iim
59  DO 25 i=1,iim
60  eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
61  25 CONTINUE
62  DO 30 j=1,iim
63  DO 30 i=1,iim
64  eignfnu(i,j) = -eignfnv(j,i)
65  30 CONTINUE
66 c
67 #ifdef CRAY
68  CALL mxm(eignfnu,iim,eignfnv,iim,vec ,iim)
69  CALL mxm(eignfnv,iim,eignfnu,iim,vec1,iim)
70 #else
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  ENDDO
79  ENDDO
80  ENDDO
81 #endif
82 
83 c
84  CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
85  CALL acc(eignfnv,d,iim)
86  CALL eigen_sort(dv,eignfnv,iim,iim)
87 c
88  CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
89  CALL acc(eignfnu,d,iim)
90  CALL eigen_sort(du,eignfnu,iim,iim)
91 
92 cc ancienne version avec appels IMSL
93 c
94 c CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
95 c CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
96 c CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
97 c CALL acc(eignfnv,d,iim)
98 c CALL eigen(eignfnv,dv)
99 c
100 c CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
101 c CALL acc(eignfnu,d,iim)
102 c CALL eigen(eignfnu,du)
103 
104  RETURN
105  END
106