trunk/dyn3d/tau2alpha.f

module tau2alpha_m

    IMPLICIT NONE

    REAL lat_min_guide, lat_max_guide

contains

  SUBROUTINE tau2alpha(type, pim, pjm, factt, taumin, taumax, alpha)
    !=======================================================================

    USE dimens_m, ONLY : iim, jjm
    USE paramet_m, ONLY : iip1, jjp1
    USE comconst, ONLY : pi
    USE comgeom, ONLY : cu_2d, cv_2d, rlatu, rlatv
    USE serre, ONLY : clat, clon, grossismx, grossismy

    !   arguments :
    INTEGER type
    INTEGER pim, pjm
    REAL factt, taumin, taumax
    REAL dxdy_, alpha(pim, pjm)
    REAL dxdy_min, dxdy_max

    !  local :
    REAL alphamin, alphamax, gamma, xi
    SAVE gamma
    INTEGER i, j, ilon, ilat

    LOGICAL first
    SAVE first
    DATA first/ .TRUE./

    REAL zdx(iip1, jjp1), zdy(iip1, jjp1)

    REAL zlat
    REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)
    COMMON /comdxdy/dxdys, dxdyu, dxdyv

    IF (first) THEN
       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)*zdx(i, j)+zdy(i, j)*zdy(i, j))
          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+1, j))
          END DO
       END DO

       CALL dump2d(iip1, jjp1, dxdys, 'DX2DY2 SCAL  ')
       CALL dump2d(iip1, jjp1, dxdyu, 'DX2DY2 U     ')
       CALL dump2d(iip1, jjp1, dxdyv, 'DX2DY2 v     ')

       !   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 maximale 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
    END IF

    alphamin = factt/taumax
    alphamax = factt/taumin

    DO j = 1, pjm
       DO i = 1, pim
          IF (type==1) THEN
             dxdy_ = dxdys(i, j)
             zlat = rlatu(j)*180./pi
          ELSE IF (type==2) THEN
             dxdy_ = dxdyu(i, j)
             zlat = rlatu(j)*180./pi
          ELSE IF (type==3) THEN
             dxdy_ = dxdyv(i, j)
             zlat = rlatv(j)*180./pi
          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
    END DO

  END SUBROUTINE tau2alpha

end module tau2alpha_m
1	module tau2alpha_m
2
3	IMPLICIT NONE
4
5	REAL lat_min_guide, lat_max_guide
6
7	contains
8
9	SUBROUTINE tau2alpha(type, pim, pjm, factt, taumin, taumax, alpha)
10	!=======================================================================
11
12	USE dimens_m, ONLY : iim, jjm
13	USE paramet_m, ONLY : iip1, jjp1
14	USE comconst, ONLY : pi
15	USE comgeom, ONLY : cu_2d, cv_2d, rlatu, rlatv
16	USE serre, ONLY : clat, clon, grossismx, grossismy
17
18	! arguments :
19	INTEGER type
20	INTEGER pim, pjm
21	REAL factt, taumin, taumax
22	REAL dxdy_, alpha(pim, pjm)
23	REAL dxdy_min, dxdy_max
24
25	! local :
26	REAL alphamin, alphamax, gamma, xi
27	SAVE gamma
28	INTEGER i, j, ilon, ilat
29
30	LOGICAL first
31	SAVE first
32	DATA first/ .TRUE./
33
34	REAL zdx(iip1, jjp1), zdy(iip1, jjp1)
35
36	REAL zlat
37	REAL dxdys(iip1, jjp1), dxdyu(iip1, jjp1), dxdyv(iip1, jjm)
38	COMMON /comdxdy/dxdys, dxdyu, dxdyv
39
40	IF (first) THEN
41	DO j = 2, jjm
42	DO i = 2, iip1
43	zdx(i, j) = 0.5*(cu_2d(i-1, j)+cu_2d(i, j))/cos(rlatu(j))
44	END DO
45	zdx(1, j) = zdx(iip1, j)
46	END DO
47	DO j = 2, jjm
48	DO i = 1, iip1
49	zdy(i, j) = 0.5*(cv_2d(i, j-1)+cv_2d(i, j))
50	END DO
51	END DO
52	DO i = 1, iip1
53	zdx(i, 1) = zdx(i, 2)
54	zdx(i, jjp1) = zdx(i, jjm)
55	zdy(i, 1) = zdy(i, 2)
56	zdy(i, jjp1) = zdy(i, jjm)
57	END DO
58	DO j = 1, jjp1
59	DO i = 1, iip1
60	dxdys(i, j) = sqrt(zdx(i, j)zdx(i, j)+zdy(i, j)zdy(i, j))
61	END DO
62	END DO
63	DO j = 1, jjp1
64	DO i = 1, iim
65	dxdyu(i, j) = 0.5*(dxdys(i, j)+dxdys(i+1, j))
66	END DO
67	dxdyu(iip1, j) = dxdyu(1, j)
68	END DO
69	DO j = 1, jjm
70	DO i = 1, iip1
71	dxdyv(i, j) = 0.5*(dxdys(i, j)+dxdys(i+1, j))
72	END DO
73	END DO
74
75	CALL dump2d(iip1, jjp1, dxdys, 'DX2DY2 SCAL ')
76	CALL dump2d(iip1, jjp1, dxdyu, 'DX2DY2 U ')
77	CALL dump2d(iip1, jjp1, dxdyv, 'DX2DY2 v ')
78
79	! coordonnees du centre du zoom
80	CALL coordij(clon, clat, ilon, ilat)
81	! aire de la maille au centre du zoom
82	dxdy_min = dxdys(ilon, ilat)
83	! dxdy maximale de la maille
84	dxdy_max = 0.
85	DO j = 1, jjp1
86	DO i = 1, iip1
87	dxdy_max = max(dxdy_max, dxdys(i, j))
88	END DO
89	END DO
90
91	IF (abs(grossismx-1.)<0.1 .OR. abs(grossismy-1.)<0.1) THEN
92	PRINT *, 'ATTENTION modele peu zoome'
93	PRINT *, 'ATTENTION on prend une constante de guidage cste'
94	gamma = 0.
95	ELSE
96	gamma = (dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
97	PRINT *, 'gamma=', gamma
98	IF (gamma<1.E-5) THEN
99	PRINT *, 'gamma =', gamma, '<1e-5'
100	STOP
101	END IF
102	PRINT *, 'gamma=', gamma
103	gamma = log(0.5)/log(gamma)
104	END IF
105	END IF
106
107	alphamin = factt/taumax
108	alphamax = factt/taumin
109
110	DO j = 1, pjm
111	DO i = 1, pim
112	IF (type==1) THEN
113	dxdy_ = dxdys(i, j)
114	zlat = rlatu(j)*180./pi
115	ELSE IF (type==2) THEN
116	dxdy_ = dxdyu(i, j)
117	zlat = rlatu(j)*180./pi
118	ELSE IF (type==3) THEN
119	dxdy_ = dxdyv(i, j)
120	zlat = rlatv(j)*180./pi
121	END IF
122	IF (abs(grossismx-1.)<0.1 .OR. abs(grossismy-1.)<0.1) THEN
123	! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
124	alpha(i, j) = alphamin
125	ELSE
126	xi = ((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
127	xi = min(xi, 1.)
128	IF (lat_min_guide<=zlat .AND. zlat<=lat_max_guide) THEN
129	alpha(i, j) = xialphamin + (1.-xi)alphamax
130	ELSE
131	alpha(i, j) = 0.
132	END IF
133	END IF
134	END DO
135	END DO
136
137	END SUBROUTINE tau2alpha
138
139	end module tau2alpha_m