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

Diff of /trunk/dyn3d/tau2alpha.f

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

trunk/libf/dyn3d/tau2alpha.f90 revision 37 by guez, Tue Dec 21 15:45:48 2010 UTC trunk/dyn3d/tau2alpha.f 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      IMPLICIT NONE    USE paramet_m, ONLY : iip1, jjp1
4      USE dimens_m, ONLY : jjm
5    
6      REAL lat_min_guide, lat_max_guide    IMPLICIT NONE
7    
8      private iip1, jjp1, jjm
9    
10      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    
     USE dimens_m, ONLY : iim, jjm  
     USE paramet_m, ONLY : iip1, jjp1  
     USE comconst, ONLY : pi  
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
18        USE dimens_m, ONLY : iim
19        use dump2d_m, only: dump2d
20        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
24      INTEGER type      REAL, intent(in):: factt, taumin, taumax
25      INTEGER pim, pjm      real, intent(out):: alpha(:, :)
     REAL factt, taumin, taumax  
     REAL dxdy_, alpha(pim, pjm)  
     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      REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)  
37      COMMON /comdxdy/dxdys, dxdyu, dxdyv      !------------------------------------------------------------
38    
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 57  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+1, j))               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 88  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.37  
changed lines
  Added in v.103
  ViewVC Help
Powered by ViewVC 1.1.21