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

Last change on this file since 5406 was 5297, checked in by abarral, 7 weeks ago

Turn gradsdef.h coefils.h into a module

  • 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.1 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!
[5246]4SUBROUTINE inifgn(dv)
5  !
6  !    ...  H.Upadyaya , O.Sharma  ...
7  !
[5281]8  USE comgeom_mod_h
[5271]9  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5297]10  USE paramet_mod_h
11  USE coefils_mod_h
[5271]12IMPLICIT NONE
13
[5246]14  REAL :: vec(iim,iim),vec1(iim,iim)
15  REAL :: dlonu(iim),dlonv(iim)
16  REAL :: du(iim),dv(iim),d(iim)
17  REAL :: pi
18  INTEGER :: i,j,k,imm1,nrot
19  EXTERNAL SSUM, acc,eigen,jacobi
20  REAL :: SSUM
21  !
[524]22
[5246]23  imm1  = iim -1
24  pi = 2.* ASIN(1.)
25  !
26  DO i=1,iim
27   dlonu(i)=  xprimu( i )
28   dlonv(i)=  xprimv( i )
29  END DO
[524]30
[5246]31  DO i=1,iim
32  sddv(i)   = SQRT(dlonv(i))
33  sddu(i)   = SQRT(dlonu(i))
34  unsddu(i) = 1./sddu(i)
35  unsddv(i) = 1./sddv(i)
36  END DO
37  !
38  DO j=1,iim
39  DO i=1,iim
40  vec(i,j)     = 0.
41  vec1(i,j)    = 0.
42  eignfnv(i,j) = 0.
43  eignfnu(i,j) = 0.
44  END DO
45  END DO
46  !
47  !
48  eignfnv(1,1)    = -1.
49  eignfnv(iim,1)  =  1.
50  DO i=1,imm1
51  eignfnv(i+1,i+1)= -1.
52  eignfnv(i,i+1)  =  1.
53  END DO
54  DO j=1,iim
55  DO i=1,iim
56  eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
57  END DO
58  END DO
59  DO j=1,iim
60  DO i=1,iim
61  eignfnu(i,j) = -eignfnv(j,i)
62  END DO
63  END DO
64  !
[524]65#ifdef CRAY
[5246]66  CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
67  CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
[524]68#else
[5246]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
[524]79#endif
80
[5246]81  !
82  CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
83  CALL acc(eignfnv,d,iim)
84  CALL eigen_sort(dv,eignfnv,iim,iim)
85  !
86  CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
87  CALL acc(eignfnu,d,iim)
88  CALL eigen_sort(du,eignfnu,iim,iim)
[524]89
[5246]90  !c   ancienne version avec appels IMSL
91  !
92  ! CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
93  ! CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
94  !     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
95  ! CALL acc(eignfnv,d,iim)
96  ! CALL eigen(eignfnv,dv)
97  !
98  ! CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
99  ! CALL acc(eignfnu,d,iim)
100  ! CALL eigen(eignfnu,du)
[524]101
[5246]102  RETURN
103END SUBROUTINE inifgn
[524]104
Note: See TracBrowser for help on using the repository browser.