source: LMDZ4/trunk/libf/filtrez/inifgn.F @ 5360

Last change on this file since 5360 was 1146, checked in by Laurent Fairhead, 16 years ago

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.3 KB
RevLine 
[524]1!
[1146]2! $Header: /home/cvsroot/LMDZ4/libf/filtrez/inifgn.F,v 1.1.1.1 2004-05-19 12:53:09 lmdzadmin Exp $
[524]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.