/[lmdze]/trunk/Sources/dyn3d/Dissipation/inidissip.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/Dissipation/inidissip.f

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

trunk/libf/dyn3d/inidissip.f90 revision 54 by guez, Tue Dec 6 15:07:04 2011 UTC trunk/libf/dyn3d/Dissipation/inidissip.f90 revision 64 by guez, Wed Aug 29 14:47:17 2012 UTC
# Line 6  module inidissip_m Line 6  module inidissip_m
6    
7    private llm    private llm
8    
9    REAL dtdiss    REAL dtdiss ! in s
10    integer idissip ! période de la dissipation (en pas de temps)    integer idissip ! période de la dissipation (en pas de temps)
11    real tetaudiv(llm), tetaurot(llm), tetah(llm)    real tetaudiv(llm), tetaurot(llm), tetah(llm) ! in s
12    real cdivu, crot, cdivh    real cdivu, crot, cdivh
13    
14  contains  contains
# Line 20  contains Line 20  contains
20      ! Initialisation de la dissipation horizontale. Calcul des valeurs      ! Initialisation de la dissipation horizontale. Calcul des valeurs
21      ! propres des opérateurs par méthode itérative.      ! propres des opérateurs par méthode itérative.
22    
23      USE comconst, ONLY : dtvr      USE comconst, ONLY: dtvr
24      use comdissnew, only: lstardis, nitergdiv, nitergrot, niterh, tetagdiv, &      use comdissnew, only: nitergdiv, nitergrot, niterh, tetagdiv, tetagrot, &
25           tetagrot, tetatemp           tetatemp
26      USE comvert, ONLY : preff, presnivs      USE comvert, ONLY: preff, presnivs
27      USE conf_gcm_m, ONLY : iperiod      USE conf_gcm_m, ONLY: iperiod
28      USE dimens_m, ONLY : iim, jjm, llm      USE dimens_m, ONLY: iim, jjm
     USE paramet_m, ONLY : jjp1  
     use jumble, only: new_unit  
29      use filtreg_m, only: filtreg      use filtreg_m, only: filtreg
30      use gradiv2_m, only: gradiv2      use gradiv2_m, only: gradiv2
31        use jumble, only: new_unit
32        USE paramet_m, ONLY: jjp1
33    
34      ! Variables local to the procedure:      ! Variables local to the procedure:
35      REAL zvert(llm), max_zvert      REAL zvert(llm), max_zvert ! no dimension
36      REAL, dimension(iim + 1, jjm + 1):: zh, zu      REAL, dimension(iim + 1, jjm + 1, 1):: zh, zu, gx, divgra, deltap
37      real zv(iim + 1, jjm), deltap(iim + 1, jjm + 1, llm)      real zv(iim + 1, jjm, 1), gy(iim + 1, jjm, 1)
38      REAL zllm      REAL zllm
39      INTEGER l, seed_size, ii, unit      INTEGER l, seed_size, ii, unit
40      REAL tetamin ! in s      REAL tetamin ! in s
# Line 49  contains Line 49  contains
49      deltap = 1.      deltap = 1.
50      call random_number(zh)      call random_number(zh)
51      zh = zh - 0.5      zh = zh - 0.5
52      CALL filtreg(zh, jjp1, 1, 2, 1, .TRUE., 1)      CALL filtreg(zh, jjp1, 1, 2, 1, .TRUE.)
53    
54      DO l = 1, 50      DO l = 1, 50
55         IF (lstardis) THEN         CALL divgrad2(1, zh, deltap, niterh, divgra, -1.)
56            CALL divgrad2(1, zh, deltap, niterh, zh, -1.)         zllm = abs(maxval(divgra))
57         ELSE         zh = divgra / zllm
           CALL divgrad(1, zh, niterh, zh, -1.)  
        END IF  
   
        zllm = abs(maxval(zh))  
        zh = zh / zllm  
58      END DO      END DO
59    
60      IF (lstardis) THEN      cdivh = 1. / zllm
        cdivh = 1. / zllm  
     ELSE  
        cdivh = zllm**(- 1. / niterh)  
     END IF  
61      PRINT *, 'cdivh = ', cdivh      PRINT *, 'cdivh = ', cdivh
62    
63      PRINT *, 'Calcul des valeurs propres de gradiv'      PRINT *, 'Calcul des valeurs propres de gradiv'
64      call random_number(zu)      call random_number(zu)
65      zu = zu - 0.5      zu = zu - 0.5
66      CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE., 1)      CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE.)
67      call random_number(zv)      call random_number(zv)
68      zv = zv - 0.5      zv = zv - 0.5
69      CALL filtreg(zv, jjm, 1, 2, 1, .FALSE., 1)      CALL filtreg(zv, jjm, 1, 2, 1, .FALSE.)
70    
71      DO l = 1, 50      DO l = 1, 50
72         IF (lstardis) THEN         CALL gradiv2(zu, zv, nitergdiv, gx, gy, -1.)
73            CALL gradiv2(1, zu, zv, nitergdiv, zu, zv, -1.)         zllm = max(abs(maxval(gx)), abs(maxval(gy)))
74         ELSE         zu = gx / zllm
75            CALL gradiv(1, zu, zv, nitergdiv, zu, zv, -1.)         zv = gy / zllm
        END IF  
   
        zllm = max(abs(maxval(zu)), abs(maxval(zv)))  
        zu = zu / zllm  
        zv = zv / zllm  
76      end DO      end DO
77    
78      IF (lstardis) THEN      cdivu = 1. / zllm
        cdivu = 1. / zllm  
     ELSE  
        cdivu = zllm**(- 1. / nitergdiv)  
     END IF  
79      PRINT *, 'cdivu = ', cdivu      PRINT *, 'cdivu = ', cdivu
80    
81      PRINT *, 'Calcul des valeurs propres de nxgrarot'      PRINT *, 'Calcul des valeurs propres de nxgrarot'
82      call random_number(zu)      call random_number(zu)
83      zu = zu - 0.5      zu = zu - 0.5
84      CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE., 1)      CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE.)
85      call random_number(zv)      call random_number(zv)
86      zv = zv - 0.5      zv = zv - 0.5
87      CALL filtreg(zv, jjm, 1, 2, 1, .FALSE., 1)      CALL filtreg(zv, jjm, 1, 2, 1, .FALSE.)
88    
89      DO l = 1, 50      DO l = 1, 50
90         IF (lstardis) THEN         CALL nxgraro2(1, zu, zv, nitergrot, gx, gy, -1.)
91            CALL nxgraro2(1, zu, zv, nitergrot, zu, zv, -1.)         zllm = max(abs(maxval(gx)), abs(maxval(gy)))
92         ELSE         zu = gx / zllm
93            CALL nxgrarot(1, zu, zv, nitergrot, zu, zv, -1.)         zv = gy / zllm
        END IF  
   
        zllm = max(abs(maxval(zu)), abs(maxval(zv)))  
        zu = zu / zllm  
        zv = zv / zllm  
94      end DO      end DO
95    
96      IF (lstardis) THEN      crot = 1. / zllm
        crot = 1. / zllm  
     ELSE  
        crot = zllm**(-1. / nitergrot)  
     END IF  
97      PRINT *, 'crot = ', crot      PRINT *, 'crot = ', crot
98    
99      ! Variation verticale du coefficient de dissipation :      ! Variation verticale du coefficient de dissipation :
# Line 133  contains Line 106  contains
106    
107      call new_unit(unit)      call new_unit(unit)
108      open(unit, file="inidissip.csv", status="replace", action="write")      open(unit, file="inidissip.csv", status="replace", action="write")
109      write(unit, fmt=*) "tetaudiv tetaurot tetah" ! title line      write(unit, fmt=*) '"tetaudiv (s)" "tetaurot (s)" "tetah (s)"' ! title line
110      do l = 1, llm      do l = 1, llm
111         write(unit, fmt=*) tetaudiv(l), tetaurot(l), tetah(l)         write(unit, fmt=*) tetaudiv(l), tetaurot(l), tetah(l)
112      end do      end do
# Line 147  contains Line 120  contains
120      idissip = max(1, int(tetamin / (2 * dtvr * iperiod))) * iperiod      idissip = max(1, int(tetamin / (2 * dtvr * iperiod))) * iperiod
121      PRINT *, 'idissip = ', idissip      PRINT *, 'idissip = ', idissip
122      dtdiss = idissip * dtvr      dtdiss = idissip * dtvr
123      PRINT *, 'dtdiss = ', dtdiss      PRINT *, 'dtdiss = ', dtdiss, "s"
124    
125    END SUBROUTINE inidissip    END SUBROUTINE inidissip
126    
Legend:
Removed from v.54  
changed lines
  Added in v.64
  ViewVC Help
Powered by ViewVC 1.1.21