source: LMDZ6/branches/LMDZ-INCA-Dyn/libf/filtrez/inifgn.F @ 4976

Last change on this file since 4976 was 2598, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn serre.h into module serre_mod.F90
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.3 KB
Line 
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
6c    ...  H.Upadyaya , O.Sharma  ...
7c
8      IMPLICIT NONE
9c
10      include "dimensions.h"
11      include "paramet.h"
12      include "comgeom.h"
13
14c
15      REAL vec(iim,iim),vec1(iim,iim)
16      REAL dlonu(iim),dlonv(iim)
17      REAL du(iim),dv(iim),d(iim)
18      REAL pi
19      INTEGER i,j,k,imm1,nrot
20C
21      include "coefils.h"
22c
23      EXTERNAL SSUM, acc,eigen,jacobi
24      REAL SSUM
25c
26
27      imm1  = iim -1
28      pi = 2.* ASIN(1.)
29C
30      DO 5 i=1,iim
31       dlonu(i)=  xprimu( i )
32       dlonv(i)=  xprimv( i )
33   5  CONTINUE
34
35      DO 12 i=1,iim
36      sddv(i)   = SQRT(dlonv(i))
37      sddu(i)   = SQRT(dlonu(i))
38      unsddu(i) = 1./sddu(i)
39      unsddv(i) = 1./sddv(i)
40  12  CONTINUE
41C
42      DO 17 j=1,iim
43      DO 17 i=1,iim
44      vec(i,j)     = 0.
45      vec1(i,j)    = 0.
46      eignfnv(i,j) = 0.
47      eignfnu(i,j) = 0.
48  17  CONTINUE
49c
50c
51      eignfnv(1,1)    = -1.
52      eignfnv(iim,1)  =  1.
53      DO 20 i=1,imm1
54      eignfnv(i+1,i+1)= -1.
55      eignfnv(i,i+1)  =  1.
56  20  CONTINUE
57      DO 25 j=1,iim
58      DO 25 i=1,iim
59      eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
60  25  CONTINUE
61      DO 30 j=1,iim
62      DO 30 i=1,iim
63      eignfnu(i,j) = -eignfnv(j,i)
64  30  CONTINUE
65c
66#ifdef CRAY
67      CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
68      CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
69#else
70      DO j = 1, iim
71      DO i = 1, iim
72        vec (i,j) = 0.0
73        vec1(i,j) = 0.0
74       DO k = 1, iim
75        vec (i,j) = vec(i,j)  + eignfnu(i,k) * eignfnv(k,j)
76        vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
77       ENDDO
78      ENDDO
79      ENDDO
80#endif
81
82c
83      CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
84      CALL acc(eignfnv,d,iim)
85      CALL eigen_sort(dv,eignfnv,iim,iim)
86c
87      CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
88      CALL acc(eignfnu,d,iim)
89      CALL eigen_sort(du,eignfnu,iim,iim)
90
91cc   ancienne version avec appels IMSL
92c
93c     CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
94c     CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
95c     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
96c     CALL acc(eignfnv,d,iim)
97c     CALL eigen(eignfnv,dv)
98c
99c     CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
100c     CALL acc(eignfnu,d,iim)
101c     CALL eigen(eignfnu,du)
102
103      RETURN
104      END
105
Note: See TracBrowser for help on using the repository browser.