/[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 143 by guez, Tue Jun 9 14:32:46 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)
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)
     END DO  
   END DO  
   DO j = 1, iim  
     DO i = 1, iim  
       eignfnu(i, j) = -eignfnv(j, i)  
     END DO  
   END DO  
30    
31    DO j = 1, iim      ! Local:
32      DO i = 1, iim      REAL vec(iim, iim), vec1(iim, iim)
33        vec(i, j) = 0.0      REAL du(iim)
34        vec1(i, j) = 0.0      INTEGER i, j, k, nrot
35        DO k = 1, iim  
36          vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)      !----------------------------------------------------------------
37          vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)  
38        END DO      sddv = sqrt(xprimv(:iim))
39        sddu = sqrt(xprimu(:iim))
40        unsddu = 1. / sddu
41        unsddv = 1. / sddv
42    
43        DO j = 1, iim
44           DO i = 1, iim
45              vec(i, j) = 0.
46              vec1(i, j) = 0.
47              eignfnv(i, j) = 0.
48              eignfnu(i, j) = 0.
49           END DO
50      END DO      END DO
   END DO  
51    
52        eignfnv(1, 1) = - 1.
53        eignfnv(iim, 1) = 1.
54        DO i = 1, iim - 1
55           eignfnv(i+1, i+1) = - 1.
56           eignfnv(i, i+1) = 1.
57        END DO
58    
59    CALL jacobi(vec, iim, iim, dv, eignfnv, nrot)      DO j = 1, iim
60    CALL acc(eignfnv, d, iim)         DO i = 1, iim
61    CALL eigen_sort(dv, eignfnv, iim, iim)            eignfnv(i, j) = eignfnv(i, j) / (sddu(i) * sddv(j))
62           END DO
63        END DO
64    
65    CALL jacobi(vec1, iim, iim, du, eignfnu, nrot)      DO j = 1, iim
66    CALL acc(eignfnu, d, iim)         DO i = 1, iim
67    CALL eigen_sort(du, eignfnu, iim, iim)            eignfnu(i, j) = - eignfnv(j, i)
68           END DO
69        END DO
70    
71    ! c   ancienne version avec appels IMSL      DO j = 1, iim
72           DO i = 1, iim
73              vec(i, j) = 0.0
74              vec1(i, j) = 0.0
75              DO k = 1, iim
76                 vec(i, j) = vec(i, j) + eignfnu(i, k) * eignfnv(k, j)
77                 vec1(i, j) = vec1(i, j) + eignfnv(i, k) * eignfnu(k, j)
78              END DO
79           END DO
80        END DO
81    
82    ! CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)      CALL jacobi(vec, dv, eignfnv, nrot)
83    ! CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)      CALL acc(eignfnv)
84    ! CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)      CALL eigsrt(dv, eignfnv)
   ! CALL acc(eignfnv,d,iim)  
   ! CALL eigen(eignfnv,dv)  
85    
86    ! CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)      CALL jacobi(vec1, du, eignfnu, nrot)
87    ! CALL acc(eignfnu,d,iim)      CALL acc(eignfnu)
88    ! CALL eigen(eignfnu,du)      CALL eigsrt(du, eignfnu)
89    
90    RETURN    END SUBROUTINE inifgn
 END SUBROUTINE inifgn  
91    
92    end module inifgn_m
Legend:
Removed from v.81  
changed lines
  Added in v.143
  ViewVC Help
Powered by ViewVC 1.1.21