/[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 112 by guez, Wed Mar 5 14:57:53 2014 UTC revision 113 by guez, Thu Sep 18 19:56:46 2014 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    IMPLICIT NONE
 ! 12:53:09 lmdzadmin Exp $  
4    
5  SUBROUTINE inifgn(dv)  contains
6    
7    ! ...  H.Upadyaya , O.Sharma  ...    SUBROUTINE inifgn(dv)
8    
9    USE dimens_m      ! From LMDZ4/libf/filtrez/inifgn.F, v 1.1.1.1 2004/05/19 12:53:09
   USE paramet_m  
   USE comgeom  
   USE serre  
   USE coefils  
   IMPLICIT NONE  
10    
11        ! H.Upadyaya, O.Sharma
12    
13        USE dimens_m, ONLY: iim
14        USE comgeom, ONLY: xprimu, xprimv
15        USE coefils, ONLY: eignfnu, eignfnv, sddu, sddv, unsddu, unsddv
16    
17    REAL vec(iim, iim), vec1(iim, iim)      real dv(iim)
   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  
18    
19    DO j = 1, iim      ! Local:
20      DO i = 1, iim      REAL vec(iim, iim), vec1(iim, iim)
21        vec(i, j) = 0.      REAL dlonu(iim), dlonv(iim)
22        vec1(i, j) = 0.      REAL du(iim)
23        eignfnv(i, j) = 0.      real d(iim)
24        eignfnu(i, j) = 0.      REAL pi
25      END DO      INTEGER i, j, k, imm1, nrot
26    END DO  
27        EXTERNAL acc, jacobi
28    
29        !----------------------------------------------------------------
30    
31        imm1 = iim - 1
32        pi = 2.*asin(1.)
33    
   eignfnv(1, 1) = -1.  
   eignfnv(iim, 1) = 1.  
   DO i = 1, imm1  
     eignfnv(i+1, i+1) = -1.  
     eignfnv(i, i+1) = 1.  
   END DO  
   DO j = 1, iim  
34      DO i = 1, iim      DO i = 1, iim
35        eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))         dlonu(i) = xprimu(i)
36           dlonv(i) = xprimv(i)
37      END DO      END DO
38    END DO  
   DO j = 1, iim  
39      DO i = 1, iim      DO i = 1, iim
40        eignfnu(i, j) = -eignfnv(j, i)         sddv(i) = sqrt(dlonv(i))
41           sddu(i) = sqrt(dlonu(i))
42           unsddu(i) = 1./sddu(i)
43           unsddv(i) = 1./sddv(i)
44      END DO      END DO
   END DO  
45    
46    DO j = 1, iim      DO j = 1, iim
47      DO i = 1, iim         DO i = 1, iim
48        vec(i, j) = 0.0            vec(i, j) = 0.
49        vec1(i, j) = 0.0            vec1(i, j) = 0.
50        DO k = 1, iim            eignfnv(i, j) = 0.
51          vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)            eignfnu(i, j) = 0.
52          vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)         END DO
53        END DO      END DO
54      END DO  
55    END DO      eignfnv(1, 1) = -1.
56        eignfnv(iim, 1) = 1.
57        DO i = 1, imm1
58    CALL jacobi(vec, iim, iim, dv, eignfnv, nrot)         eignfnv(i+1, i+1) = -1.
59    CALL acc(eignfnv, d, iim)         eignfnv(i, i+1) = 1.
60    CALL eigen_sort(dv, eignfnv, iim, iim)      END DO
61        DO j = 1, iim
62    CALL jacobi(vec1, iim, iim, du, eignfnu, nrot)         DO i = 1, iim
63    CALL acc(eignfnu, d, iim)            eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))
64    CALL eigen_sort(du, eignfnu, iim, iim)         END DO
65        END DO
66    ! c   ancienne version avec appels IMSL      DO j = 1, iim
67           DO i = 1, iim
68    ! CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)            eignfnu(i, j) = -eignfnv(j, i)
69    ! CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)         END DO
70    ! CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)      END DO
71    ! CALL acc(eignfnv,d,iim)  
72    ! CALL eigen(eignfnv,dv)      DO j = 1, iim
73           DO i = 1, iim
74    ! CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)            vec(i, j) = 0.0
75    ! CALL acc(eignfnu,d,iim)            vec1(i, j) = 0.0
76    ! CALL eigen(eignfnu,du)            DO k = 1, iim
77                 vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)
78                 vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)
79              END DO
80           END DO
81        END DO
82    
83        CALL jacobi(vec, iim, iim, dv, eignfnv, nrot)
84        CALL acc(eignfnv, d, iim)
85        CALL eigen_sort(dv, eignfnv, iim, iim)
86    
87        CALL jacobi(vec1, iim, iim, du, eignfnu, nrot)
88        CALL acc(eignfnu, d, iim)
89        CALL eigen_sort(du, eignfnu, iim, iim)
90    
91    RETURN    END SUBROUTINE inifgn
 END SUBROUTINE inifgn  
92    
93    end module inifgn_m
Legend:
Removed from v.112  
changed lines
  Added in v.113
  ViewVC Help
Powered by ViewVC 1.1.21