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

Diff of /trunk/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 134 by guez, Wed Apr 29 15:47:56 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 coefils, ONLY: eignfnu, eignfnv, sddu, sddv, unsddu, unsddv
14        USE comgeom, ONLY: xprimu, xprimv
15        USE dimens_m, ONLY: iim
16        use numer_rec_95, only: jacobi
17    
18    REAL vec(iim, iim), vec1(iim, iim)      real, intent(out):: 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  
19    
20    DO j = 1, iim      ! Local:
21      DO i = 1, iim      REAL vec(iim, iim), vec1(iim, iim)
22        vec(i, j) = 0.      REAL du(iim)
23        vec1(i, j) = 0.      real d(iim)
24        eignfnv(i, j) = 0.      REAL pi
25        eignfnu(i, j) = 0.      INTEGER i, j, k, imm1, nrot
26      END DO  
27    END DO      EXTERNAL acc
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))         sddv(i) = sqrt(xprimv(i))
36           sddu(i) = sqrt(xprimu(i))
37           unsddu(i) = 1./sddu(i)
38           unsddv(i) = 1./sddv(i)
39      END DO      END DO
40    END DO  
41    DO j = 1, iim      DO j = 1, iim
42      DO i = 1, iim         DO i = 1, iim
43        eignfnu(i, j) = -eignfnv(j, i)            vec(i, j) = 0.
44              vec1(i, j) = 0.
45              eignfnv(i, j) = 0.
46              eignfnu(i, j) = 0.
47           END DO
48      END DO      END DO
   END DO  
49    
50    DO j = 1, iim      eignfnv(1, 1) = -1.
51      DO i = 1, iim      eignfnv(iim, 1) = 1.
52        vec(i, j) = 0.0      DO i = 1, imm1
53        vec1(i, j) = 0.0         eignfnv(i+1, i+1) = -1.
54        DO k = 1, iim         eignfnv(i, i+1) = 1.
55          vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)      END DO
56          vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)      DO j = 1, iim
57        END DO         DO i = 1, iim
58      END DO            eignfnv(i, j) = eignfnv(i, j)/(sddu(i)*sddv(j))
59    END DO         END DO
60        END DO
61        DO j = 1, iim
62    CALL jacobi(vec, iim, iim, dv, eignfnv, nrot)         DO i = 1, iim
63    CALL acc(eignfnv, d, iim)            eignfnu(i, j) = -eignfnv(j, i)
64    CALL eigen_sort(dv, eignfnv, iim, iim)         END DO
65        END DO
66    CALL jacobi(vec1, iim, iim, du, eignfnu, nrot)  
67    CALL acc(eignfnu, d, iim)      DO j = 1, iim
68    CALL eigen_sort(du, eignfnu, iim, iim)         DO i = 1, iim
69              vec(i, j) = 0.0
70    ! c   ancienne version avec appels IMSL            vec1(i, j) = 0.0
71              DO k = 1, iim
72    ! CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)               vec(i, j) = vec(i, j) + eignfnu(i, k)*eignfnv(k, j)
73    ! CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)               vec1(i, j) = vec1(i, j) + eignfnv(i, k)*eignfnu(k, j)
74    ! CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)            END DO
75    ! CALL acc(eignfnv,d,iim)         END DO
76    ! CALL eigen(eignfnv,dv)      END DO
77    
78    ! CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)      CALL jacobi(vec, dv, eignfnv, nrot)
79    ! CALL acc(eignfnu,d,iim)      CALL acc(eignfnv, d, iim)
80    ! CALL eigen(eignfnu,du)      CALL eigen_sort(dv, eignfnv, iim, iim)
81    
82        CALL jacobi(vec1, du, eignfnu, nrot)
83        CALL acc(eignfnu, d, iim)
84        CALL eigen_sort(du, eignfnu, iim, iim)
85    
86    RETURN    END SUBROUTINE inifgn
 END SUBROUTINE inifgn  
87    
88    end module inifgn_m
Legend:
Removed from v.81  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.21