/[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 82 by guez, Wed Mar 5 14:57:53 2014 UTC revision 121 by guez, Wed Jan 28 16:10:02 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    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 du(iim)
22        vec1(i, j) = 0.      real d(iim)
23        eignfnv(i, j) = 0.      REAL pi
24        eignfnu(i, j) = 0.      INTEGER i, j, k, imm1, nrot
25      END DO  
26    END DO      EXTERNAL acc, jacobi
27    
28        !----------------------------------------------------------------
29    
30        imm1 = iim - 1
31        pi = 2.*asin(1.)
32    
   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  
33      DO i = 1, iim      DO i = 1, iim
34        eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))         sddv(i) = sqrt(xprimv(i))
35           sddu(i) = sqrt(xprimu(i))
36           unsddu(i) = 1./sddu(i)
37           unsddv(i) = 1./sddv(i)
38      END DO      END DO
39    END DO  
40    DO j = 1, iim      DO j = 1, iim
41      DO i = 1, iim         DO i = 1, iim
42        eignfnu(i, j) = -eignfnv(j, i)            vec(i, j) = 0.
43              vec1(i, j) = 0.
44              eignfnv(i, j) = 0.
45              eignfnu(i, j) = 0.
46           END DO
47      END DO      END DO
   END DO  
48    
49    DO j = 1, iim      eignfnv(1, 1) = -1.
50      DO i = 1, iim      eignfnv(iim, 1) = 1.
51        vec(i, j) = 0.0      DO i = 1, imm1
52        vec1(i, j) = 0.0         eignfnv(i+1, i+1) = -1.
53        DO k = 1, iim         eignfnv(i, i+1) = 1.
54          vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)      END DO
55          vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)      DO j = 1, iim
56        END DO         DO i = 1, iim
57      END DO            eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))
58    END DO         END DO
59        END DO
60        DO j = 1, iim
61    CALL jacobi(vec, iim, iim, dv, eignfnv, nrot)         DO i = 1, iim
62    CALL acc(eignfnv, d, iim)            eignfnu(i, j) = -eignfnv(j, i)
63    CALL eigen_sort(dv, eignfnv, iim, iim)         END DO
64        END DO
65    CALL jacobi(vec1, iim, iim, du, eignfnu, nrot)  
66    CALL acc(eignfnu, d, iim)      DO j = 1, iim
67    CALL eigen_sort(du, eignfnu, iim, iim)         DO i = 1, iim
68              vec(i, j) = 0.0
69    ! c   ancienne version avec appels IMSL            vec1(i, j) = 0.0
70              DO k = 1, iim
71    ! CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)               vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)
72    ! CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)               vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)
73    ! CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)            END DO
74    ! CALL acc(eignfnv,d,iim)         END DO
75    ! CALL eigen(eignfnv,dv)      END DO
76    
77    ! CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)      CALL jacobi(vec, iim, iim, dv, eignfnv, nrot)
78    ! CALL acc(eignfnu,d,iim)      CALL acc(eignfnv, d, iim)
79    ! CALL eigen(eignfnu,du)      CALL eigen_sort(dv, eignfnv, iim, iim)
80    
81        CALL jacobi(vec1, iim, iim, du, eignfnu, nrot)
82        CALL acc(eignfnu, d, iim)
83        CALL eigen_sort(du, eignfnu, iim, iim)
84    
85    RETURN    END SUBROUTINE inifgn
 END SUBROUTINE inifgn  
86    
87    end module inifgn_m
Legend:
Removed from v.82  
changed lines
  Added in v.121
  ViewVC Help
Powered by ViewVC 1.1.21