source: LMDZ6/trunk/libf/filtrez/inifgn.F @ 5080

Last change on this file since 5080 was 5079, checked in by abarral, 4 months ago

[coherence with Fortran standards]
Replace obsolete DO with shared termination
(minor) replace obsolete bool operators

  • 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
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
[2598]10      include "dimensions.h"
11      include "paramet.h"
12      include "comgeom.h"
[524]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
[2598]21      include "coefils.h"
[524]22c
23      EXTERNAL SSUM, acc,eigen,jacobi
24      REAL SSUM
25c
26
27      imm1  = iim -1
28      pi = 2.* ASIN(1.)
29C
[5079]30      DO i=1,iim
[524]31       dlonu(i)=  xprimu( i )
32       dlonv(i)=  xprimv( i )
[5079]33      END DO
[524]34
[5079]35      DO i=1,iim
[524]36      sddv(i)   = SQRT(dlonv(i))
37      sddu(i)   = SQRT(dlonu(i))
38      unsddu(i) = 1./sddu(i)
39      unsddv(i) = 1./sddv(i)
[5079]40      END DO
[524]41C
[5079]42      DO j=1,iim
43      DO i=1,iim
[524]44      vec(i,j)     = 0.
45      vec1(i,j)    = 0.
46      eignfnv(i,j) = 0.
47      eignfnu(i,j) = 0.
[5079]48      END DO
49      END DO
[524]50c
51c
52      eignfnv(1,1)    = -1.
53      eignfnv(iim,1)  =  1.
[5079]54      DO i=1,imm1
[524]55      eignfnv(i+1,i+1)= -1.
56      eignfnv(i,i+1)  =  1.
[5079]57      END DO
58      DO j=1,iim
59      DO i=1,iim
[524]60      eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
[5079]61      END DO
62      END DO
63      DO j=1,iim
64      DO i=1,iim
[524]65      eignfnu(i,j) = -eignfnv(j,i)
[5079]66      END DO
67      END DO
[524]68c
69#ifdef CRAY
70      CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
71      CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
72#else
73      DO j = 1, iim
74      DO i = 1, iim
75        vec (i,j) = 0.0
76        vec1(i,j) = 0.0
77       DO k = 1, iim
78        vec (i,j) = vec(i,j)  + eignfnu(i,k) * eignfnv(k,j)
79        vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
80       ENDDO
81      ENDDO
82      ENDDO
83#endif
84
85c
86      CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
87      CALL acc(eignfnv,d,iim)
88      CALL eigen_sort(dv,eignfnv,iim,iim)
89c
90      CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
91      CALL acc(eignfnu,d,iim)
92      CALL eigen_sort(du,eignfnu,iim,iim)
93
94cc   ancienne version avec appels IMSL
95c
96c     CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
97c     CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
98c     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
99c     CALL acc(eignfnv,d,iim)
100c     CALL eigen(eignfnv,dv)
101c
102c     CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
103c     CALL acc(eignfnu,d,iim)
104c     CALL eigen(eignfnu,du)
105
106      RETURN
107      END
108
Note: See TracBrowser for help on using the repository browser.