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