source: LMDZ6/branches/Amaury_dev/libf/filtrez/inifgn.F @ 5099

Last change on this file since 5099 was 5099, checked in by abarral, 8 weeks ago

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

  • 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.2 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 i=1,iim
31       dlonu(i)=  xprimu( i )
32       dlonv(i)=  xprimv( i )
33      END DO
34
35      DO 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      END DO
41C
42      DO j=1,iim
43      DO i=1,iim
44      vec(i,j)     = 0.
45      vec1(i,j)    = 0.
46      eignfnv(i,j) = 0.
47      eignfnu(i,j) = 0.
48      END DO
49      END DO
50c
51c
52      eignfnv(1,1)    = -1.
53      eignfnv(iim,1)  =  1.
54      DO i=1,imm1
55      eignfnv(i+1,i+1)= -1.
56      eignfnv(i,i+1)  =  1.
57      END DO
58      DO j=1,iim
59      DO i=1,iim
60      eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
61      END DO
62      END DO
63      DO j=1,iim
64      DO i=1,iim
65      eignfnu(i,j) = -eignfnv(j,i)
66      END DO
67      END DO
68c
69      DO j = 1, iim
70      DO i = 1, iim
71        vec (i,j) = 0.0
72        vec1(i,j) = 0.0
73       DO k = 1, iim
74        vec (i,j) = vec(i,j)  + eignfnu(i,k) * eignfnv(k,j)
75        vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
76       ENDDO
77      ENDDO
78      ENDDO
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.