/[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

revision 55 by guez, Mon Dec 12 13:25:01 2011 UTC revision 57 by guez, Mon Jan 30 12:54:02 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 26  contains Line 26  contains
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, llm
     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 53  contains Line 53  contains
53    
54      DO l = 1, 50      DO l = 1, 50
55         IF (lstardis) THEN         IF (lstardis) THEN
56            CALL divgrad2(1, zh, deltap, niterh, zh, -1.)            CALL divgrad2(1, zh, deltap, niterh, divgra, -1.)
57         ELSE         ELSE
58            CALL divgrad(1, zh, niterh, zh, -1.)            CALL divgrad(1, zh, niterh, divgra, -1.)
59         END IF         END IF
60    
61         zllm = abs(maxval(zh))         zllm = abs(maxval(divgra))
62         zh = zh / zllm         zh = divgra / zllm
63      END DO      END DO
64    
65      IF (lstardis) THEN      IF (lstardis) THEN
# Line 79  contains Line 79  contains
79    
80      DO l = 1, 50      DO l = 1, 50
81         IF (lstardis) THEN         IF (lstardis) THEN
82            CALL gradiv2(1, zu, zv, nitergdiv, zu, zv, -1.)            CALL gradiv2(zu, zv, nitergdiv, gx, gy, -1.)
83         ELSE         ELSE
84            CALL gradiv(1, zu, zv, nitergdiv, zu, zv, -1.)            CALL gradiv(1, zu, zv, nitergdiv, gx, gy, -1.)
85         END IF         END IF
86    
87         zllm = max(abs(maxval(zu)), abs(maxval(zv)))         zllm = max(abs(maxval(gx)), abs(maxval(gy)))
88         zu = zu / zllm         zu = gx / zllm
89         zv = zv / zllm         zv = gy / zllm
90      end DO      end DO
91    
92      IF (lstardis) THEN      IF (lstardis) THEN
# Line 106  contains Line 106  contains
106    
107      DO l = 1, 50      DO l = 1, 50
108         IF (lstardis) THEN         IF (lstardis) THEN
109            CALL nxgraro2(1, zu, zv, nitergrot, zu, zv, -1.)            CALL nxgraro2(1, zu, zv, nitergrot, gx, gy, -1.)
110         ELSE         ELSE
111            CALL nxgrarot(1, zu, zv, nitergrot, zu, zv, -1.)            CALL nxgrarot(1, zu, zv, nitergrot, gx, gy, -1.)
112         END IF         END IF
113    
114         zllm = max(abs(maxval(zu)), abs(maxval(zv)))         zllm = max(abs(maxval(gx)), abs(maxval(gy)))
115         zu = zu / zllm         zu = gx / zllm
116         zv = zv / zllm         zv = gy / zllm
117      end DO      end DO
118    
119      IF (lstardis) THEN      IF (lstardis) THEN
120         crot = 1. / zllm         crot = 1. / zllm
121      ELSE      ELSE
122         crot = zllm**(-1. / nitergrot)         crot = zllm**(- 1. / nitergrot)
123      END IF      END IF
124      PRINT *, 'crot = ', crot      PRINT *, 'crot = ', crot
125    
# Line 133  contains Line 133  contains
133    
134      call new_unit(unit)      call new_unit(unit)
135      open(unit, file="inidissip.csv", status="replace", action="write")      open(unit, file="inidissip.csv", status="replace", action="write")
136      write(unit, fmt=*) "tetaudiv tetaurot tetah" ! title line      write(unit, fmt=*) '"tetaudiv (s)" "tetaurot (s)" "tetah (s)"' ! title line
137      do l = 1, llm      do l = 1, llm
138         write(unit, fmt=*) tetaudiv(l), tetaurot(l), tetah(l)         write(unit, fmt=*) tetaudiv(l), tetaurot(l), tetah(l)
139      end do      end do
# Line 147  contains Line 147  contains
147      idissip = max(1, int(tetamin / (2 * dtvr * iperiod))) * iperiod      idissip = max(1, int(tetamin / (2 * dtvr * iperiod))) * iperiod
148      PRINT *, 'idissip = ', idissip      PRINT *, 'idissip = ', idissip
149      dtdiss = idissip * dtvr      dtdiss = idissip * dtvr
150      PRINT *, 'dtdiss = ', dtdiss      PRINT *, 'dtdiss = ', dtdiss, "s"
151    
152    END SUBROUTINE inidissip    END SUBROUTINE inidissip
153    
Legend:
Removed from v.55  
changed lines
  Added in v.57
  ViewVC Help
Powered by ViewVC 1.1.21