/[lmdze]/trunk/libf/dyn3d/Dissipation/inidissip.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/Dissipation/inidissip.f90

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

revision 39 by guez, Tue Jan 25 15:11:05 2011 UTC revision 40 by guez, Tue Feb 22 13:49:36 2011 UTC
# Line 7  module inidissip_m Line 7  module inidissip_m
7    private llm    private llm
8    
9    REAL dtdiss    REAL dtdiss
10    integer idissip ! periode de la dissipation (en pas)    integer idissip ! période de la dissipation (en pas)
11    real tetaudiv(llm),tetaurot(llm),tetah(llm)      real tetaudiv(llm), tetaurot(llm), tetah(llm)
12    real cdivu, crot, cdivh    real cdivu, crot, cdivh
13    
14  contains  contains
# Line 16  contains Line 16  contains
16    SUBROUTINE inidissip    SUBROUTINE inidissip
17    
18      ! From dyn3d/inidissip.F, version 1.1.1.1 2004/05/19 12:53:06      ! From dyn3d/inidissip.F, version 1.1.1.1 2004/05/19 12:53:06
19      ! Initialisation de la dissipation horizontale                              ! Initialisation de la dissipation horizontale
20    
21      USE comconst, ONLY : dtvr      USE comconst, ONLY : dtvr
22      use comdissnew, only: lstardis, nitergdiv, nitergrot, niterh, tetagdiv, &      use comdissnew, only: lstardis, nitergdiv, nitergrot, niterh, tetagdiv, &
# Line 31  contains Line 31  contains
31      ! Variables local to the procedure:      ! Variables local to the procedure:
32      REAL zvert(llm), max_zvert      REAL zvert(llm), max_zvert
33      REAL zh(ip1jmp1), zu(ip1jmp1), zv(ip1jm), deltap(ip1jmp1, llm)      REAL zh(ip1jmp1), zu(ip1jmp1), zv(ip1jm), deltap(ip1jmp1, llm)
34      REAL ullm, vllm, umin, vmin, zhmin, zhmax      REAL zhmin, zhmax
35      REAL zllm, z1llm      REAL zllm
36      INTEGER l, ij, idum, ii, unit      INTEGER l, ij, idum, ii, unit
37      REAL tetamin ! in s      REAL tetamin ! in s
38      REAL ran1      REAL ran1
# Line 41  contains Line 41  contains
41    
42      PRINT *, 'Call sequence information: inidissip'      PRINT *, 'Call sequence information: inidissip'
43    
44      !   calcul des valeurs propres des operateurs par methode iterrative:        ! Calcul des valeurs propres des opérateurs par méthode itérative :
45    
46      crot = -1.      crot = -1.
47      cdivu = -1.      cdivu = -1.
48      cdivh = -1.      cdivh = -1.
49    
50      !   calcul de la valeur propre de divgrad:                                    ! Calcul de la valeur propre de divgrad :
   
     idum = 0  
     DO l = 1, llm  
        DO ij = 1, ip1jmp1  
           deltap(ij, l) = 1.  
        END DO  
     END DO  
51    
52        deltap = 1.
53      idum = -1      idum = -1
54      zh(1) = ran1(idum) - .5      zh(1) = ran1(idum) - 0.5
55      idum = 0      idum = 0
56      DO ij = 2, ip1jmp1      DO ij = 2, ip1jmp1
57         zh(ij) = ran1(idum) - .5         zh(ij) = ran1(idum) - 0.5
58      END DO      END DO
59    
60      CALL filtreg(zh, jjp1, 1, 2, 1, .TRUE., 1)      CALL filtreg(zh, jjp1, 1, 2, 1, .TRUE., 1)
# Line 72  contains Line 66  contains
66         STOP 1         STOP 1
67      END IF      END IF
68    
     zllm = abs(zhmax)  
69      DO l = 1, 50      DO l = 1, 50
70         IF (lstardis) THEN         IF (lstardis) THEN
71            CALL divgrad2(1, zh, deltap, niterh, zh)            CALL divgrad2(1, zh, deltap, niterh, zh)
# Line 80  contains Line 73  contains
73            CALL divgrad(1, zh, niterh, zh)            CALL divgrad(1, zh, niterh, zh)
74         END IF         END IF
75    
76         CALL minmax(iip1*jjp1, zh, zhmin, zhmax)         zllm = abs(maxval(zh))
77           zh = zh / zllm
        zllm = abs(zhmax)  
        z1llm = 1./zllm  
        DO ij = 1, ip1jmp1  
           zh(ij) = zh(ij)*z1llm  
        END DO  
78      END DO      END DO
79    
80      IF (lstardis) THEN      IF (lstardis) THEN
81         cdivh = 1./zllm         cdivh = 1. / zllm
82      ELSE      ELSE
83         cdivh = zllm**(-1./niterh)         cdivh = zllm**(- 1. / niterh)
84      END IF      END IF
85    
86      !   calcul des valeurs propres de gradiv (ii =1) et  nxgrarot(ii=2)          ! Calcul des valeurs propres de gradiv (ii = 1) et nxgrarot (ii = 2)
87    
88      PRINT *, 'calcul des valeurs propres'      PRINT *, 'Calcul des valeurs propres'
89    
90      DO  ii = 1, 2      DO ii = 1, 2
91         DO ij = 1, ip1jmp1         DO ij = 1, ip1jmp1
92            zu(ij) = ran1(idum) - .5            zu(ij) = ran1(idum) - 0.5
93         END DO         END DO
94         CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE., 1)         CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE., 1)
95         DO ij = 1, ip1jm         DO ij = 1, ip1jm
96            zv(ij) = ran1(idum) - .5            zv(ij) = ran1(idum) - 0.5
97         END DO         END DO
98         CALL filtreg(zv, jjm, 1, 2, 1, .FALSE., 1)         CALL filtreg(zv, jjm, 1, 2, 1, .FALSE., 1)
99    
100         CALL minmax(iip1*jjp1, zu, umin, ullm)         DO l = 1, 50
        CALL minmax(iip1*jjm, zv, vmin, vllm)  
   
        ullm = abs(ullm)  
        vllm = abs(vllm)  
   
        DO  l = 1, 50  
101            IF (ii==1) THEN            IF (ii==1) THEN
102               IF (lstardis) THEN               IF (lstardis) THEN
103                  CALL gradiv2(1, zu, zv, nitergdiv, zu, zv)                  CALL gradiv2(1, zu, zv, nitergdiv, zu, zv)
# Line 130  contains Line 112  contains
112               END IF               END IF
113            END IF            END IF
114    
115            CALL minmax(iip1*jjp1, zu, umin, ullm)            zllm = max(abs(maxval(zu)), abs(maxval(zv)))
116            CALL minmax(iip1*jjm, zv, vmin, vllm)            zu = zu / zllm
117              zv = zv / zllm
           ullm = abs(ullm)  
           vllm = abs(vllm)  
   
           zllm = max(ullm, vllm)  
           z1llm = 1./zllm  
           DO ij = 1, ip1jmp1  
              zu(ij) = zu(ij)*z1llm  
           END DO  
           DO ij = 1, ip1jm  
              zv(ij) = zv(ij)*z1llm  
           END DO  
118         end DO         end DO
119    
120         IF (ii==1) THEN         IF (ii==1) THEN
121            IF (lstardis) THEN            IF (lstardis) THEN
122               cdivu = 1./zllm               cdivu = 1. / zllm
123            ELSE            ELSE
124               cdivu = zllm**(-1./nitergdiv)               cdivu = zllm**(- 1. / nitergdiv)
125            END IF            END IF
126         ELSE         ELSE
127            IF (lstardis) THEN            IF (lstardis) THEN
128               crot = 1./zllm               crot = 1./zllm
129            ELSE            ELSE
130               crot = zllm**(-1./nitergrot)               crot = zllm**(-1. / nitergrot)
131            END IF            END IF
132         END IF         END IF
133      END DO      END DO
Legend:
Removed from v.39  
changed lines
  Added in v.40
  ViewVC Help
Powered by ViewVC 1.1.21