/[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/dyn3d/tau2alpha.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 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      USE paramet_m, ONLY : iip1, jjp1    IMPLICIT NONE
     USE dimens_m, ONLY : jjm  
   
     IMPLICIT NONE  
   
     private iip1, jjp1, jjm  
   
     REAL lat_min_guide, lat_max_guide  
     REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)  
4    
5  contains  contains
6    
7    SUBROUTINE tau2alpha(type, pim, pjm, factt, taumin, taumax, alpha)    SUBROUTINE tau2alpha(type, factt, taumin, taumax, alpha)
8    
9        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      USE dimens_m, ONLY : iim
13      USE nr_util, ONLY : pi      USE nr_util, ONLY : pi
14      USE comgeom, ONLY : cu_2d, cv_2d, rlatu, rlatv      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
     INTEGER type  
     INTEGER pim, pjm  
19      REAL, intent(in):: factt, taumin, taumax      REAL, intent(in):: factt, taumin, taumax
20      REAL dxdy_, alpha(pim, pjm)      real, intent(out):: alpha(:, :)
     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)
32    
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 58  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 91  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.76  
changed lines
  Added in v.109
  ViewVC Help
Powered by ViewVC 1.1.21