source: LMDZ.3.3/branches/LF/libf/filtrez/inifgn.F

Last change on this file was 2, checked in by lmdz, 25 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 2.2 KB
Line 
1      SUBROUTINE inifgn(dv)
2
3c    ...  H.Upadyaya , O.Sharma  ...
4c
5      IMPLICIT NONE
6c
7#include "dimensions.h"
8#include "paramet.h"
9#include "comgeom.h"
10#include "serre.h"
11
12c
13      REAL vec(iim,iim),vec1(iim,iim)
14      REAL dlonu(iim),dlonv(iim)
15      REAL du(iim),dv(iim),d(iim)
16      REAL pi
17      INTEGER i,j,k,imm1,nrot
18C
19#include "coefils.h"
20c
21      EXTERNAL SSUM, acc,eigen,jacobi
22      REAL SSUM
23c
24
25      imm1  = iim -1
26      pi = 2.* ASIN(1.)
27C
28      DO 5 i=1,iim
29       dlonu(i)=  xprimu( i )
30       dlonv(i)=  xprimv( i )
31   5  CONTINUE
32
33      DO 12 i=1,iim
34      sddv(i)   = SQRT(dlonv(i))
35      sddu(i)   = SQRT(dlonu(i))
36      unsddu(i) = 1./sddu(i)
37      unsddv(i) = 1./sddv(i)
38  12  CONTINUE
39C
40      DO 17 j=1,iim
41      DO 17 i=1,iim
42      vec(i,j)     = 0.
43      vec1(i,j)    = 0.
44      eignfnv(i,j) = 0.
45      eignfnu(i,j) = 0.
46  17  CONTINUE
47c
48c
49      eignfnv(1,1)    = -1.
50      eignfnv(iim,1)  =  1.
51      DO 20 i=1,imm1
52      eignfnv(i+1,i+1)= -1.
53      eignfnv(i,i+1)  =  1.
54  20  CONTINUE
55      DO 25 j=1,iim
56      DO 25 i=1,iim
57      eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
58  25  CONTINUE
59      DO 30 j=1,iim
60      DO 30 i=1,iim
61      eignfnu(i,j) = -eignfnv(j,i)
62  30  CONTINUE
63c
64#ifdef CRAY
65      CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
66      CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
67#else
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#endif
79
80c
81      CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
82      CALL acc(eignfnv,d,iim)
83      CALL eigen_sort(dv,eignfnv,iim,iim)
84c
85      CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
86      CALL acc(eignfnu,d,iim)
87      CALL eigen_sort(du,eignfnu,iim,iim)
88
89cc   ancienne version avec appels IMSL
90c
91c     CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
92c     CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
93c     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
94c     CALL acc(eignfnv,d,iim)
95c     CALL eigen(eignfnv,dv)
96c
97c     CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
98c     CALL acc(eignfnu,d,iim)
99c     CALL eigen(eignfnu,du)
100
101      RETURN
102      END
103
Note: See TracBrowser for help on using the repository browser.