source: LMDZ5/branches/AI-cosp/libf/filtrez/inifgn.F @ 3452

Last change on this file since 3452 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • 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#include "serre.h"
14
15c
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
21C
22#include "coefils.h"
23c
24      EXTERNAL SSUM, acc,eigen,jacobi
25      REAL SSUM
26c
27
28      imm1  = iim -1
29      pi = 2.* ASIN(1.)
30C
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
42C
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
50c
51c
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
66c
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
83c
84      CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
85      CALL acc(eignfnv,d,iim)
86      CALL eigen_sort(dv,eignfnv,iim,iim)
87c
88      CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
89      CALL acc(eignfnu,d,iim)
90      CALL eigen_sort(du,eignfnu,iim,iim)
91
92cc   ancienne version avec appels IMSL
93c
94c     CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
95c     CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
96c     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
97c     CALL acc(eignfnv,d,iim)
98c     CALL eigen(eignfnv,dv)
99c
100c     CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
101c     CALL acc(eignfnu,d,iim)
102c     CALL eigen(eignfnu,du)
103
104      RETURN
105      END
106
Note: See TracBrowser for help on using the repository browser.