/[lmdze]/trunk/dyn3d/tau2alpha.f
ViewVC logotype

Diff of /trunk/dyn3d/tau2alpha.f

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

revision 102 by guez, Tue Jul 15 13:43:24 2014 UTC revision 103 by guez, Fri Aug 29 13:00:05 2014 UTC
# Line 1  Line 1 
1  module tau2alpha_m  module tau2alpha_m
2    
3      USE paramet_m, ONLY : iip1, jjp1    USE paramet_m, ONLY : iip1, jjp1
4      USE dimens_m, ONLY : jjm    USE dimens_m, ONLY : jjm
5    
6      IMPLICIT NONE    IMPLICIT NONE
7    
8      private iip1, jjp1, jjm    private iip1, jjp1, jjm
9    
10      REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)    REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)
11    
12  contains  contains
13    
14    SUBROUTINE tau2alpha(type, pim, pjm, factt, taumin, taumax, alpha)    SUBROUTINE tau2alpha(type, factt, taumin, taumax, alpha)
15    
16      USE comgeom, ONLY : cu_2d, cv_2d, rlatu, rlatv      USE comgeom, ONLY : cu_2d, cv_2d, rlatu, rlatv
17      use conf_guide_m, only: lat_min_guide, lat_max_guide      use conf_guide_m, only: lat_min_guide, lat_max_guide
     use dump2d_m, only: dump2d  
18      USE dimens_m, ONLY : iim      USE dimens_m, ONLY : iim
19        use dump2d_m, only: dump2d
20      USE nr_util, ONLY : pi      USE nr_util, ONLY : pi
21      USE serre, ONLY : clat, clon, grossismx, grossismy      USE serre, ONLY : clat, clon, grossismx, grossismy
22    
23      !   arguments :      INTEGER, intent(in):: type
     INTEGER type  
     INTEGER pim, pjm  
24      REAL, intent(in):: factt, taumin, taumax      REAL, intent(in):: factt, taumin, taumax
25      REAL dxdy_, alpha(pim, pjm)      real, intent(out):: alpha(:, :)
     REAL dxdy_min, dxdy_max  
26    
27      !  local :      ! Local:
28      REAL alphamin, alphamax, gamma, xi      REAL dxdy
29      SAVE gamma      REAL dxdy_min, dxdy_max
30        REAL alphamin, alphamax, xi
31        REAL, SAVE:: gamma
32      INTEGER i, j, ilon, ilat      INTEGER i, j, ilon, ilat
33        LOGICAL:: first = .TRUE.
     LOGICAL first  
     SAVE first  
     DATA first/ .TRUE./  
   
34      REAL zdx(iip1, jjp1), zdy(iip1, jjp1)      REAL zdx(iip1, jjp1), zdy(iip1, jjp1)
35      REAL zlat      REAL zlat
36    
# Line 44  contains Line 39  contains
39      IF (first) THEN      IF (first) THEN
40         DO j = 2, jjm         DO j = 2, jjm
41            DO i = 2, iip1            DO i = 2, iip1
42               zdx(i, j) = 0.5*(cu_2d(i-1, j)+cu_2d(i, j))/cos(rlatu(j))               zdx(i, j) = 0.5 * (cu_2d(i - 1, j) + cu_2d(i, j)) / cos(rlatu(j))
43            END DO            END DO
44            zdx(1, j) = zdx(iip1, j)            zdx(1, j) = zdx(iip1, j)
45         END DO         END DO
46         DO j = 2, jjm         DO j = 2, jjm
47            DO i = 1, iip1            DO i = 1, iip1
48               zdy(i, j) = 0.5*(cv_2d(i, j-1)+cv_2d(i, j))               zdy(i, j) = 0.5 * (cv_2d(i, j - 1) + cv_2d(i, j))
49            END DO            END DO
50         END DO         END DO
51         DO i = 1, iip1         DO i = 1, iip1
# Line 61  contains Line 56  contains
56         END DO         END DO
57         DO j = 1, jjp1         DO j = 1, jjp1
58            DO i = 1, iip1            DO i = 1, iip1
59               dxdys(i, j) = sqrt(zdx(i, j)*zdx(i, j)+zdy(i, j)*zdy(i, j))               dxdys(i, j) = sqrt(zdx(i, j)**2 + zdy(i, j)**2)
60            END DO            END DO
61         END DO         END DO
62         DO j = 1, jjp1         DO j = 1, jjp1
63            DO i = 1, iim            DO i = 1, iim
64               dxdyu(i, j) = 0.5*(dxdys(i, j)+dxdys(i+1, j))               dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))
65            END DO            END DO
66            dxdyu(iip1, j) = dxdyu(1, j)            dxdyu(iip1, j) = dxdyu(1, j)
67         END DO         END DO
68         DO j = 1, jjm         DO j = 1, jjm
69            DO i = 1, iip1            DO i = 1, iip1
70               dxdyv(i, j) = 0.5*(dxdys(i, j)+dxdys(i, j + 1))               dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))
71            END DO            END DO
72         END DO         END DO
73    
74         CALL dump2d(iip1, jjp1, dxdys, 'DX2DY2 SCAL  ')         CALL dump2d(iip1, jjp1, dxdys, 'DX2DY2 SCAL ')
75         CALL dump2d(iip1, jjp1, dxdyu, 'DX2DY2 U     ')         CALL dump2d(iip1, jjp1, dxdyu, 'DX2DY2 U ')
76         CALL dump2d(iip1, jjp1, dxdyv, 'DX2DY2 v     ')         CALL dump2d(iip1, jjp1, dxdyv, 'DX2DY2 v ')
77    
78         !   coordonnees du centre du zoom         ! coordonnees du centre du zoom
79         CALL coordij(clon, clat, ilon, ilat)         CALL coordij(clon, clat, ilon, ilat)
80         !   aire de la maille au centre du zoom         ! aire de la maille au centre du zoom
81         dxdy_min = dxdys(ilon, ilat)         dxdy_min = dxdys(ilon, ilat)
82         !   dxdy maximale de la maille  
83           ! dxdy maximal de la maille :
84         dxdy_max = 0.         dxdy_max = 0.
85         DO j = 1, jjp1         DO j = 1, jjp1
86            DO i = 1, iip1            DO i = 1, iip1
# Line 92  contains Line 88  contains
88            END DO            END DO
89         END DO         END DO
90    
91         IF (abs(grossismx-1.)<0.1 .OR. abs(grossismy-1.)<0.1) THEN         IF (abs(grossismx - 1.)<0.1 .OR. abs(grossismy - 1.)<0.1) THEN
92            PRINT *, 'ATTENTION modele peu zoome'            PRINT *, 'ATTENTION modele peu zoome'
93            PRINT *, 'ATTENTION on prend une constante de guidage cste'            PRINT *, 'ATTENTION on prend une constante de guidage cste'
94            gamma = 0.            gamma = 0.
95         ELSE         ELSE
96            gamma = (dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)            gamma = (dxdy_max - 2. * dxdy_min) / (dxdy_max - dxdy_min)
97            PRINT *, 'gamma=', gamma            PRINT *, 'gamma=', gamma
98            IF (gamma<1.E-5) THEN            IF (gamma<1.E-5) THEN
99               PRINT *, 'gamma =', gamma, '<1e-5'               PRINT *, 'gamma =', gamma, '<1e-5'
100               STOP               STOP
101            END IF            END IF
102            PRINT *, 'gamma=', gamma            PRINT *, 'gamma=', gamma
103            gamma = log(0.5)/log(gamma)            gamma = log(0.5) / log(gamma)
104         END IF         END IF
105           first = .false.
106      END IF      END IF
107    
108      alphamin = factt/taumax      alphamin = factt / taumax
109      alphamax = factt/taumin      alphamax = factt / taumin
110    
111      DO j = 1, pjm      DO j = 1, size(alpha, 2)
112         DO i = 1, pim         DO i = 1, size(alpha, 1)
113            IF (type==1) THEN            IF (type==1) THEN
114               dxdy_ = dxdys(i, j)               dxdy = dxdys(i, j)
115               zlat = rlatu(j)*180./pi               zlat = rlatu(j) * 180. / pi
116            ELSE IF (type==2) THEN            ELSE IF (type==2) THEN
117               dxdy_ = dxdyu(i, j)               dxdy = dxdyu(i, j)
118               zlat = rlatu(j)*180./pi               zlat = rlatu(j) * 180. / pi
119            ELSE IF (type==3) THEN            ELSE IF (type==3) THEN
120               dxdy_ = dxdyv(i, j)               dxdy = dxdyv(i, j)
121               zlat = rlatv(j)*180./pi               zlat = rlatv(j) * 180. / pi
122            END IF            END IF
123            IF (abs(grossismx-1.)<0.1 .OR. abs(grossismy-1.)<0.1) THEN            IF (abs(grossismx - 1.)<0.1 .OR. abs(grossismy - 1.)<0.1) THEN
124               !  pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin               ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
125               alpha(i, j) = alphamin               alpha(i, j) = alphamin
126            ELSE            ELSE
127               xi = ((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma               xi = ((dxdy_max - dxdy) / (dxdy_max - dxdy_min))**gamma
128               xi = min(xi, 1.)               xi = min(xi, 1.)
129               IF (lat_min_guide<=zlat .AND. zlat<=lat_max_guide) THEN               IF (lat_min_guide <= zlat .AND. zlat <= lat_max_guide) THEN
130                  alpha(i, j) = xi*alphamin + (1.-xi)*alphamax                  alpha(i, j) = xi * alphamin + (1. - xi) * alphamax
131               ELSE               ELSE
132                  alpha(i, j) = 0.                  alpha(i, j) = 0.
133               END IF               END IF
Legend:
Removed from v.102  
changed lines
  Added in v.103
  ViewVC Help
Powered by ViewVC 1.1.21