source: LMDZ6/trunk/libf/filtrez/inifgn.F90 @ 5281

Last change on this file since 5281 was 5281, checked in by abarral, 4 days ago

Turn comgeom.h comgeom2.h into modules

  • 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!
4SUBROUTINE inifgn(dv)
5  !
6  !    ...  H.Upadyaya , O.Sharma  ...
7  !
8  USE comgeom_mod_h
9  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
10USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
11          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
12IMPLICIT NONE
13  !
14
15
16
17  !
18  REAL :: vec(iim,iim),vec1(iim,iim)
19  REAL :: dlonu(iim),dlonv(iim)
20  REAL :: du(iim),dv(iim),d(iim)
21  REAL :: pi
22  INTEGER :: i,j,k,imm1,nrot
23  !
24  include "coefils.h"
25  !
26  EXTERNAL SSUM, acc,eigen,jacobi
27  REAL :: SSUM
28  !
29
30  imm1  = iim -1
31  pi = 2.* ASIN(1.)
32  !
33  DO i=1,iim
34   dlonu(i)=  xprimu( i )
35   dlonv(i)=  xprimv( i )
36  END DO
37
38  DO i=1,iim
39  sddv(i)   = SQRT(dlonv(i))
40  sddu(i)   = SQRT(dlonu(i))
41  unsddu(i) = 1./sddu(i)
42  unsddv(i) = 1./sddv(i)
43  END DO
44  !
45  DO j=1,iim
46  DO i=1,iim
47  vec(i,j)     = 0.
48  vec1(i,j)    = 0.
49  eignfnv(i,j) = 0.
50  eignfnu(i,j) = 0.
51  END DO
52  END DO
53  !
54  !
55  eignfnv(1,1)    = -1.
56  eignfnv(iim,1)  =  1.
57  DO i=1,imm1
58  eignfnv(i+1,i+1)= -1.
59  eignfnv(i,i+1)  =  1.
60  END DO
61  DO j=1,iim
62  DO i=1,iim
63  eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
64  END DO
65  END DO
66  DO j=1,iim
67  DO i=1,iim
68  eignfnu(i,j) = -eignfnv(j,i)
69  END DO
70  END DO
71  !
72#ifdef CRAY
73  CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
74  CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
75#else
76  DO j = 1, iim
77  DO i = 1, iim
78    vec (i,j) = 0.0
79    vec1(i,j) = 0.0
80   DO k = 1, iim
81    vec (i,j) = vec(i,j)  + eignfnu(i,k) * eignfnv(k,j)
82    vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
83   ENDDO
84  ENDDO
85  ENDDO
86#endif
87
88  !
89  CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
90  CALL acc(eignfnv,d,iim)
91  CALL eigen_sort(dv,eignfnv,iim,iim)
92  !
93  CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
94  CALL acc(eignfnu,d,iim)
95  CALL eigen_sort(du,eignfnu,iim,iim)
96
97  !c   ancienne version avec appels IMSL
98  !
99  ! CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
100  ! CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
101  !     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
102  ! CALL acc(eignfnv,d,iim)
103  ! CALL eigen(eignfnv,dv)
104  !
105  ! CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
106  ! CALL acc(eignfnu,d,iim)
107  ! CALL eigen(eignfnu,du)
108
109  RETURN
110END SUBROUTINE inifgn
111
Note: See TracBrowser for help on using the repository browser.