/[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/dyn3d/Dissipation/inidissip.f revision 82 by guez, Wed Mar 5 14:57:53 2014 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-1
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 disvert_m, 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
29      USE paramet_m, ONLY : jjp1      use divgrad2_m, only: divgrad2
     use jumble, only: new_unit  
30      use filtreg_m, only: filtreg      use filtreg_m, only: filtreg
31      use gradiv2_m, only: gradiv2      use gradiv2_m, only: gradiv2
32        use jumble, only: new_unit
33        use nxgraro2_m, only: nxgraro2
34        USE paramet_m, ONLY: jjp1
35    
36      ! Variables local to the procedure:      ! Variables local to the procedure:
37      REAL zvert(llm), max_zvert      REAL zvert(llm), max_zvert ! no dimension
38      REAL, dimension(iim + 1, jjm + 1):: zh, zu      REAL, dimension(iim + 1, jjm + 1, 1):: zh, zu, gx, divgra, deltap
39      real zv(iim + 1, jjm), deltap(iim + 1, jjm + 1, llm)      real zv(iim + 1, jjm, 1), gy(iim + 1, jjm, 1)
40      REAL zllm      REAL zllm
41      INTEGER l, seed_size, ii, unit      INTEGER l, seed_size, ii, unit
42      REAL tetamin ! in s      REAL tetamin ! in s
# Line 43  contains Line 45  contains
45    
46      PRINT *, 'Call sequence information: inidissip'      PRINT *, 'Call sequence information: inidissip'
47      call random_seed(size=seed_size)      call random_seed(size=seed_size)
48      call random_seed(put=(/(0, ii = 1, seed_size)/))      call random_seed(put=(/(1, ii = 1, seed_size)/))
49    
50      PRINT *, 'Calcul des valeurs propres de divgrad'      PRINT *, 'Calcul des valeurs propres de divgrad'
51      deltap = 1.      deltap = 1.
52      call random_number(zh)      call random_number(zh)
53      zh = zh - 0.5      zh = zh - 0.5
54      CALL filtreg(zh, jjp1, 1, 2, 1, .TRUE., 1)      CALL filtreg(zh, jjp1, 1, 2, 1, .TRUE.)
55    
56      DO l = 1, 50      DO l = 1, 50
57         IF (lstardis) THEN         CALL divgrad2(1, zh, deltap, niterh, divgra, -1.)
58            CALL divgrad2(1, zh, deltap, niterh, zh, -1.)         zllm = abs(maxval(divgra))
59         ELSE         zh = divgra / zllm
           CALL divgrad(1, zh, niterh, zh, -1.)  
        END IF  
   
        zllm = abs(maxval(zh))  
        zh = zh / zllm  
60      END DO      END DO
61    
62      IF (lstardis) THEN      cdivh = 1. / zllm
        cdivh = 1. / zllm  
     ELSE  
        cdivh = zllm**(- 1. / niterh)  
     END IF  
63      PRINT *, 'cdivh = ', cdivh      PRINT *, 'cdivh = ', cdivh
64    
65      PRINT *, 'Calcul des valeurs propres de gradiv'      PRINT *, 'Calcul des valeurs propres de gradiv'
66      call random_number(zu)      call random_number(zu)
67      zu = zu - 0.5      zu = zu - 0.5
68      CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE., 1)      CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE.)
69      call random_number(zv)      call random_number(zv)
70      zv = zv - 0.5      zv = zv - 0.5
71      CALL filtreg(zv, jjm, 1, 2, 1, .FALSE., 1)      CALL filtreg(zv, jjm, 1, 2, 1, .FALSE.)
72    
73      DO l = 1, 50      DO l = 1, 50
74         IF (lstardis) THEN         CALL gradiv2(zu, zv, nitergdiv, gx, gy, -1.)
75            CALL gradiv2(1, zu, zv, nitergdiv, zu, zv, -1.)         zllm = max(abs(maxval(gx)), abs(maxval(gy)))
76         ELSE         zu = gx / zllm
77            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  
78      end DO      end DO
79    
80      IF (lstardis) THEN      cdivu = 1. / zllm
        cdivu = 1. / zllm  
     ELSE  
        cdivu = zllm**(- 1. / nitergdiv)  
     END IF  
81      PRINT *, 'cdivu = ', cdivu      PRINT *, 'cdivu = ', cdivu
82    
83      PRINT *, 'Calcul des valeurs propres de nxgrarot'      PRINT *, 'Calcul des valeurs propres de nxgrarot'
84      call random_number(zu)      call random_number(zu)
85      zu = zu - 0.5      zu = zu - 0.5
86      CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE., 1)      CALL filtreg(zu, jjp1, 1, 2, 1, .TRUE.)
87      call random_number(zv)      call random_number(zv)
88      zv = zv - 0.5      zv = zv - 0.5
89      CALL filtreg(zv, jjm, 1, 2, 1, .FALSE., 1)      CALL filtreg(zv, jjm, 1, 2, 1, .FALSE.)
90    
91      DO l = 1, 50      DO l = 1, 50
92         IF (lstardis) THEN         CALL nxgraro2(zu, zv, nitergrot, gx, gy, -1.)
93            CALL nxgraro2(1, zu, zv, nitergrot, zu, zv, -1.)         zllm = max(abs(maxval(gx)), abs(maxval(gy)))
94         ELSE         zu = gx / zllm
95            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  
96      end DO      end DO
97    
98      IF (lstardis) THEN      crot = 1. / zllm
        crot = 1. / zllm  
     ELSE  
        crot = zllm**(-1. / nitergrot)  
     END IF  
99      PRINT *, 'crot = ', crot      PRINT *, 'crot = ', crot
100    
101      ! Variation verticale du coefficient de dissipation :      ! Variation verticale du coefficient de dissipation :
# Line 131  contains Line 106  contains
106      tetaurot = zvert / tetagrot      tetaurot = zvert / tetagrot
107      tetah = zvert / tetatemp      tetah = zvert / tetatemp
108    
     call new_unit(unit)  
     open(unit, file="inidissip.csv", status="replace", action="write")  
     write(unit, fmt=*) "tetaudiv tetaurot tetah" ! title line  
     do l = 1, llm  
        write(unit, fmt=*) tetaudiv(l), tetaurot(l), tetah(l)  
     end do  
     close(unit)  
     print *, 'Created file "inidissip.csv".'  
   
109      max_zvert = maxval(zvert)      max_zvert = maxval(zvert)
110      tetamin = min(1e6, tetagdiv / max_zvert, tetagrot / max_zvert, &      tetamin = min(1e6, tetagdiv / max_zvert, tetagrot / max_zvert, &
111           tetatemp / max_zvert)           tetatemp / max_zvert)
# Line 147  contains Line 113  contains
113      idissip = max(1, int(tetamin / (2 * dtvr * iperiod))) * iperiod      idissip = max(1, int(tetamin / (2 * dtvr * iperiod))) * iperiod
114      PRINT *, 'idissip = ', idissip      PRINT *, 'idissip = ', idissip
115      dtdiss = idissip * dtvr      dtdiss = idissip * dtvr
116      PRINT *, 'dtdiss = ', dtdiss      PRINT *, 'dtdiss = ', dtdiss, "s"
117    
118        call new_unit(unit)
119        open(unit, file="inidissip.csv", status="replace", action="write")
120    
121        ! Title line:
122        write(unit, fmt=*) '"presnivs (hPa)" "dtdiss * tetaudiv" ' &
123             // '"dtdiss * tetaurot" "dtdiss * tetah"'
124    
125        do l = 1, llm
126           write(unit, fmt=*) presnivs(l) / 100., dtdiss * tetaudiv(l), &
127                dtdiss * tetaurot(l), dtdiss * tetah(l)
128        end do
129        close(unit)
130        print *, 'Created file "inidissip.csv".'
131    
132    END SUBROUTINE inidissip    END SUBROUTINE inidissip
133    
Legend:
Removed from v.54  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21