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

Diff of /trunk/Sources/dyn3d/Guide/tau2alpha.f

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

trunk/dyn3d/tau2alpha.f revision 103 by guez, Fri Aug 29 13:00:05 2014 UTC trunk/dyn3d/Guide/tau2alpha.f revision 115 by guez, Fri Sep 19 17:36:20 2014 UTC
# Line 1  Line 1 
1  module tau2alpha_m  module tau2alpha_m
2    
   USE paramet_m, ONLY : iip1, jjp1  
   USE dimens_m, ONLY : jjm  
   
3    IMPLICIT NONE    IMPLICIT NONE
4    
   private iip1, jjp1, jjm  
   
   REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)  
   
5  contains  contains
6    
7    SUBROUTINE tau2alpha(type, factt, taumin, taumax, alpha)    SUBROUTINE tau2alpha(dxdy, rlat, taumin, taumax, alpha)
8    
9      USE comgeom, ONLY : cu_2d, cv_2d, rlatu, rlatv      use conf_guide_m, only: lat_min_guide, lat_max_guide, factt
10      use conf_guide_m, only: lat_min_guide, lat_max_guide      use init_tau2alpha_m, only: dxdy_min, dxdy_max, gamma
11      USE dimens_m, ONLY : iim      USE nr_util, ONLY: pi, assert_eq
12      use dump2d_m, only: dump2d  
13      USE nr_util, ONLY : pi      REAL, intent(in):: dxdy(:, :) ! (n_lon, n_lat)
14      USE serre, ONLY : clat, clon, grossismx, grossismy      REAL, intent(in):: rlat(:) ! (n_lat)
15        REAL, intent(in):: taumin, taumax
16      INTEGER, intent(in):: type      real, intent(out):: alpha(:, :) ! (n_lon, n_lat)
     REAL, intent(in):: factt, taumin, taumax  
     real, intent(out):: alpha(:, :)  
17    
18      ! Local:      ! Local:
     REAL dxdy  
     REAL dxdy_min, dxdy_max  
19      REAL alphamin, alphamax, xi      REAL alphamin, alphamax, xi
20      REAL, SAVE:: gamma      INTEGER i, j, n_lon, n_lat
     INTEGER i, j, ilon, ilat  
     LOGICAL:: first = .TRUE.  
     REAL zdx(iip1, jjp1), zdy(iip1, jjp1)  
21      REAL zlat      REAL zlat
22    
23      !------------------------------------------------------------      !------------------------------------------------------------
24    
25      IF (first) THEN      PRINT *, 'Call sequence information: tau2alpha'
        DO j = 2, jjm  
           DO i = 2, iip1  
              zdx(i, j) = 0.5 * (cu_2d(i - 1, j) + cu_2d(i, j)) / cos(rlatu(j))  
           END DO  
           zdx(1, j) = zdx(iip1, j)  
        END DO  
        DO j = 2, jjm  
           DO i = 1, iip1  
              zdy(i, j) = 0.5 * (cv_2d(i, j - 1) + cv_2d(i, j))  
           END DO  
        END DO  
        DO i = 1, iip1  
           zdx(i, 1) = zdx(i, 2)  
           zdx(i, jjp1) = zdx(i, jjm)  
           zdy(i, 1) = zdy(i, 2)  
           zdy(i, jjp1) = zdy(i, jjm)  
        END DO  
        DO j = 1, jjp1  
           DO i = 1, iip1  
              dxdys(i, j) = sqrt(zdx(i, j)**2 + zdy(i, j)**2)  
           END DO  
        END DO  
        DO j = 1, jjp1  
           DO i = 1, iim  
              dxdyu(i, j) = 0.5 * (dxdys(i, j) + dxdys(i + 1, j))  
           END DO  
           dxdyu(iip1, j) = dxdyu(1, j)  
        END DO  
        DO j = 1, jjm  
           DO i = 1, iip1  
              dxdyv(i, j) = 0.5 * (dxdys(i, j) + dxdys(i, j + 1))  
           END DO  
        END DO  
26    
27         CALL dump2d(iip1, jjp1, dxdys, 'DX2DY2 SCAL ')      n_lon = assert_eq(size(alpha, 1), size(dxdy, 1), "tau2alpha n_lon")
28         CALL dump2d(iip1, jjp1, dxdyu, 'DX2DY2 U ')      n_lat = assert_eq(size(alpha, 2), size(dxdy, 2), size(rlat), &
29         CALL dump2d(iip1, jjp1, dxdyv, 'DX2DY2 v ')           "tau2alpha n_lat")
   
        ! coordonnees du centre du zoom  
        CALL coordij(clon, clat, ilon, ilat)  
        ! aire de la maille au centre du zoom  
        dxdy_min = dxdys(ilon, ilat)  
   
        ! dxdy maximal de la maille :  
        dxdy_max = 0.  
        DO j = 1, jjp1  
           DO i = 1, iip1  
              dxdy_max = max(dxdy_max, dxdys(i, j))  
           END DO  
        END DO  
   
        IF (abs(grossismx - 1.)<0.1 .OR. abs(grossismy - 1.)<0.1) THEN  
           PRINT *, 'ATTENTION modele peu zoome'  
           PRINT *, 'ATTENTION on prend une constante de guidage cste'  
           gamma = 0.  
        ELSE  
           gamma = (dxdy_max - 2. * dxdy_min) / (dxdy_max - dxdy_min)  
           PRINT *, 'gamma=', gamma  
           IF (gamma<1.E-5) THEN  
              PRINT *, 'gamma =', gamma, '<1e-5'  
              STOP  
           END IF  
           PRINT *, 'gamma=', gamma  
           gamma = log(0.5) / log(gamma)  
        END IF  
        first = .false.  
     END IF  
30    
31      alphamin = factt / taumax      alphamin = factt / taumax
32      alphamax = factt / taumin      alphamax = factt / taumin
33    
34      DO j = 1, size(alpha, 2)      DO j = 1, n_lat
35         DO i = 1, size(alpha, 1)         zlat = rlat(j) * 180. / pi
36            IF (type==1) THEN         IF (lat_min_guide <= zlat .AND. zlat <= lat_max_guide) THEN
37               dxdy = dxdys(i, j)            DO i = 1, n_lon
38               zlat = rlatu(j) * 180. / pi               xi = min(((dxdy_max - dxdy(i, j)) &
39            ELSE IF (type==2) THEN                    / (dxdy_max - dxdy_min))**gamma, 1.)
40               dxdy = dxdyu(i, j)               alpha(i, j) = xi * alphamin + (1. - xi) * alphamax
41               zlat = rlatu(j) * 180. / pi            END DO
42            ELSE IF (type==3) THEN         ELSE
43               dxdy = dxdyv(i, j)            alpha(:, j) = 0.
44               zlat = rlatv(j) * 180. / pi         END IF
           END IF  
           IF (abs(grossismx - 1.)<0.1 .OR. abs(grossismy - 1.)<0.1) THEN  
              ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin  
              alpha(i, j) = alphamin  
           ELSE  
              xi = ((dxdy_max - dxdy) / (dxdy_max - dxdy_min))**gamma  
              xi = min(xi, 1.)  
              IF (lat_min_guide <= zlat .AND. zlat <= lat_max_guide) THEN  
                 alpha(i, j) = xi * alphamin + (1. - xi) * alphamax  
              ELSE  
                 alpha(i, j) = 0.  
              END IF  
           END IF  
        END DO  
45      END DO      END DO
46    
47    END SUBROUTINE tau2alpha    END SUBROUTINE tau2alpha
Legend:
Removed from v.103  
changed lines
  Added in v.115
  ViewVC Help
Powered by ViewVC 1.1.21