/[lmdze]/trunk/filtrez/inifgn.f
ViewVC logotype

Diff of /trunk/filtrez/inifgn.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 139 by guez, Tue May 26 17:46:03 2015 UTC revision 151 by guez, Tue Jun 23 15:14:20 2015 UTC
# Line 1  Line 1 
1  module inifgn_m  module inifgn_m
2    
3      use dimens_m, only: iim
4    
5    IMPLICIT NONE    IMPLICIT NONE
6    
7      private iim
8    
9      real sddu(iim), sddv(iim) ! SQRT(dx / di)
10      real unsddu(iim), unsddv(iim)
11    
12      real eignfnu(iim, iim), eignfnv(iim, iim)
13      ! eigenfunctions of the discrete laplacian
14    
15  contains  contains
16    
17    SUBROUTINE inifgn(dv)    SUBROUTINE inifgn(dv)
18    
19      ! From LMDZ4/libf/filtrez/inifgn.F, v 1.1.1.1 2004/05/19 12:53:09      ! From LMDZ4/libf/filtrez/inifgn.F, v 1.1.1.1 2004/05/19 12:53:09
20    
21      ! H.Upadyaya, O.Sharma      ! H. Upadyaya, O. Sharma
22    
23      USE coefils, ONLY: eignfnu, eignfnv, sddu, sddv, unsddu, unsddv      use acc_m, only: acc
24      USE dimens_m, ONLY: iim      USE dimens_m, ONLY: iim
25      USE dynetat0_m, ONLY: xprimu, xprimv      USE dynetat0_m, ONLY: xprimu, xprimv
26      use numer_rec_95, only: jacobi      use nr_util, only: pi
27        use numer_rec_95, only: jacobi, eigsrt
28    
29      real, intent(out):: dv(iim)      real, intent(out):: dv(:) ! (iim) eigenvalues sorted in descending order
30    
31      ! Local:      ! Local:
32      REAL vec(iim, iim), vec1(iim, iim)      REAL vec(iim, iim), vec1(iim, iim)
33      REAL du(iim)      REAL du(iim)
34      real d(iim)      INTEGER i, j, k, nrot
     REAL pi  
     INTEGER i, j, k, imm1, nrot  
   
     EXTERNAL acc  
35    
36      !----------------------------------------------------------------      !----------------------------------------------------------------
37    
38      imm1 = iim - 1      print *, "Call sequence information: inifgn"
     pi = 2.*asin(1.)  
39    
40      DO i = 1, iim      sddv = sqrt(xprimv(:iim))
41         sddv(i) = sqrt(xprimv(i))      sddu = sqrt(xprimu(:iim))
42         sddu(i) = sqrt(xprimu(i))      unsddu = 1. / sddu
43         unsddu(i) = 1./sddu(i)      unsddv = 1. / sddv
        unsddv(i) = 1./sddv(i)  
     END DO  
44    
45      DO j = 1, iim      DO j = 1, iim
46         DO i = 1, iim         DO i = 1, iim
# Line 47  contains Line 51  contains
51         END DO         END DO
52      END DO      END DO
53    
54      eignfnv(1, 1) = -1.      eignfnv(1, 1) = - 1.
55      eignfnv(iim, 1) = 1.      eignfnv(iim, 1) = 1.
56      DO i = 1, imm1      DO i = 1, iim - 1
57         eignfnv(i+1, i+1) = -1.         eignfnv(i+1, i+1) = - 1.
58         eignfnv(i, i+1) = 1.         eignfnv(i, i+1) = 1.
59      END DO      END DO
60    
61      DO j = 1, iim      DO j = 1, iim
62         DO i = 1, iim         DO i = 1, iim
63            eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))            eignfnv(i, j) = eignfnv(i, j) / (sddu(i) * sddv(j))
64         END DO         END DO
65      END DO      END DO
66    
67      DO j = 1, iim      DO j = 1, iim
68         DO i = 1, iim         DO i = 1, iim
69            eignfnu(i, j) = -eignfnv(j, i)            eignfnu(i, j) = - eignfnv(j, i)
70         END DO         END DO
71      END DO      END DO
72    
# Line 69  contains Line 75  contains
75            vec(i, j) = 0.0            vec(i, j) = 0.0
76            vec1(i, j) = 0.0            vec1(i, j) = 0.0
77            DO k = 1, iim            DO k = 1, iim
78               vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)               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)               vec1(i, j) = vec1(i, j) + eignfnv(i, k) * eignfnu(k, j)
80            END DO            END DO
81         END DO         END DO
82      END DO      END DO
83    
84      CALL jacobi(vec, dv, eignfnv, nrot)      CALL jacobi(vec, dv, eignfnv, nrot)
85      CALL acc(eignfnv, d, iim)      CALL acc(eignfnv)
86      CALL eigen_sort(dv, eignfnv, iim, iim)      CALL eigsrt(dv, eignfnv)
87    
88      CALL jacobi(vec1, du, eignfnu, nrot)      CALL jacobi(vec1, du, eignfnu, nrot)
89      CALL acc(eignfnu, d, iim)      CALL acc(eignfnu)
90      CALL eigen_sort(du, eignfnu, iim, iim)      CALL eigsrt(du, eignfnu)
91    
92    END SUBROUTINE inifgn    END SUBROUTINE inifgn
93    
Legend:
Removed from v.139  
changed lines
  Added in v.151
  ViewVC Help
Powered by ViewVC 1.1.21