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

Diff of /trunk/Sources/filtrez/inifgn.f

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

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