/[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 83 by guez, Thu Mar 6 15:12:00 2014 UTC revision 108 by guez, Tue Sep 16 14:00:41 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
17      use conf_guide_m, only: lat_min_guide, lat_max_guide      use conf_guide_m, only: lat_min_guide, lat_max_guide
18      USE dimens_m, ONLY : iim      USE dimens_m, ONLY : iim
19      USE nr_util, ONLY : pi      USE nr_util, ONLY : pi
     USE comgeom, ONLY : cu_2d, cv_2d, rlatu, rlatv  
20      USE serre, ONLY : clat, clon, grossismx, grossismy      USE serre, ONLY : clat, clon, grossismx, grossismy
21    
22      !   arguments :      INTEGER, intent(in):: type
     INTEGER type  
     INTEGER pim, pjm  
23      REAL, intent(in):: factt, taumin, taumax      REAL, intent(in):: factt, taumin, taumax
24      REAL dxdy_, alpha(pim, pjm)      real, intent(out):: alpha(:, :)
     REAL dxdy_min, dxdy_max  
25    
26      !  local :      ! Local:
27      REAL alphamin, alphamax, gamma, xi      REAL dxdy
28      SAVE gamma      REAL dxdy_min, dxdy_max
29        REAL alphamin, alphamax, xi
30        REAL, SAVE:: gamma
31      INTEGER i, j, ilon, ilat      INTEGER i, j, ilon, ilat
32        LOGICAL:: first = .TRUE.
     LOGICAL first  
     SAVE first  
     DATA first/ .TRUE./  
   
33      REAL zdx(iip1, jjp1), zdy(iip1, jjp1)      REAL zdx(iip1, jjp1), zdy(iip1, jjp1)
34      REAL zlat      REAL zlat
35    
# Line 43  contains Line 38  contains
38      IF (first) THEN      IF (first) THEN
39         DO j = 2, jjm         DO j = 2, jjm
40            DO i = 2, iip1            DO i = 2, iip1
41               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))
42            END DO            END DO
43            zdx(1, j) = zdx(iip1, j)            zdx(1, j) = zdx(iip1, j)
44         END DO         END DO
45         DO j = 2, jjm         DO j = 2, jjm
46            DO i = 1, iip1            DO i = 1, iip1
47               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))
48            END DO            END DO
49         END DO         END DO
50         DO i = 1, iip1         DO i = 1, iip1
# Line 60  contains Line 55  contains
55         END DO         END DO
56         DO j = 1, jjp1         DO j = 1, jjp1
57            DO i = 1, iip1            DO i = 1, iip1
58               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)
59            END DO            END DO
60         END DO         END DO
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.83  
changed lines
  Added in v.108
  ViewVC Help
Powered by ViewVC 1.1.21