/[lmdze]/trunk/filtrez/inifilr.f
ViewVC logotype

Annotation of /trunk/filtrez/inifilr.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 167 - (hide annotations)
Mon Aug 24 16:30:33 2015 UTC (8 years, 9 months ago) by guez
Original Path: trunk/Sources/filtrez/inifilr.f
File size: 3786 byte(s) 
Added program test_inifilr.

Encapsulated ppm3d into a module and added implicit none. Removed
unused argument dum.

Encountered a problem in procedure invert_zoom_x. With grossismx=2.9,
DZOOMX=0.3, taux=5, for xuv = -0.25, for i = 1, rtsafe fails because
fval is about 1e-16 instead of 0 at xval = pi. So distinguished the
cases abs_y = 0 or pi. Needed then to add argument beta to
invert_zoom_x.

Moved the output of eignvalues of differentiation matrix from inifilr
to inifgn, where they are computed.

Simpler definition of j1 in inifilr.
1 guez 54 module inifilr_m
2 guez 3
3 guez 32 IMPLICIT NONE
4 guez 3
5 guez 136 ! North:
6 guez 156
7 guez 164 INTEGER jfiltnu, jfiltnv
8     ! index of the last scalar line filtered in northern hemisphere
9    
10 guez 166 real, pointer:: matriceun(:, :, :) ! (iim, iim, jfiltnu - 1)
11 guez 165 ! matrice filtre pour les champs situes sur la grille scalaire
12 guez 3
13 guez 166 real, pointer:: matrinvn(:, :, :) ! (iim, iim, jfiltnu - 1)
14 guez 165 ! matrice filtre pour les champs situes sur la grille scalaire, pour
15     ! le filtre inverse
16    
17 guez 166 real, pointer:: matricevn(:, :, :) ! (iim, iim, jfiltnv)
18 guez 165 ! matrice filtre pour les champs situes sur la grille de V ou de Z
19 guez 3
20 guez 136 ! South:
21 guez 156
22 guez 164 integer jfiltsu, jfiltsv
23     ! index of the first line filtered in southern hemisphere
24    
25 guez 166 real, pointer:: matriceus(:, :, :) ! (iim, iim, jjm - jfiltsu + 1)
26 guez 165 ! matrice filtre pour les champs situes sur la grille scalaire
27 guez 136
28 guez 166 real, pointer:: matrinvs(:, :, :) ! (iim, iim, jjm - jfiltsu + 1)
29 guez 165 ! matrice filtre pour les champs situes sur la grille scalaire, pour
30     ! le filtre inverse
31    
32 guez 166 real, pointer:: matricevs(:, :, :) ! (iim, iim, jjm - jfiltsv + 1)
33 guez 165 ! matrice filtre pour les champs situes sur la grille de V ou de Z
34 guez 136
35 guez 54 contains
36 guez 3
37 guez 54 SUBROUTINE inifilr
38 guez 3
39 guez 164 ! From filtrez/inifilr.F, version 1.1.1.1, 2004/05/19 12:53:09
40 guez 54 ! H. Upadhyaya, O. Sharma
41 guez 3
42 guez 164 ! This procedure computes the filtering coefficients for scalar
43     ! lines and meridional wind v lines. The modes are filtered from
44     ! modfrst to iim. We filter all those latitude lines where coefil
45     ! < 1. No filtering at poles. colat0 is to be used when alpha
46     ! (stretching coefficient) is set equal to zero for the regular
47     ! grid case.
48 guez 3
49 guez 54 USE dimens_m, ONLY : iim, jjm
50 guez 139 USE dynetat0_m, ONLY : rlatu, rlatv, xprimu, grossismx
51 guez 154 use inifgn_m, only: inifgn
52 guez 166 use inifilr_hemisph_m, only: inifilr_hemisph
53 guez 143 use jumble, only: new_unit
54 guez 166 use nr_util, only: pi, ifirstloc
55 guez 3
56 guez 54 ! Local:
57 guez 164
58 guez 132 REAL dlatu(jjm)
59 guez 166 REAL rlamda(2:iim) ! > 0, in descending order
60 guez 164 real eignvl(iim) ! eigenvalues sorted in descending order (<= 0)
61 guez 166 INTEGER j, unit
62 guez 151 REAL colat0 ! > 0
63 guez 166 integer j1 ! index of smallest positive latitude
64 guez 3
65 guez 154 real eignfnu(iim, iim), eignfnv(iim, iim)
66 guez 164 ! eigenvectors of the discrete second derivative with respect to longitude
67 guez 154
68 guez 54 !-----------------------------------------------------------
69 guez 3
70 guez 54 print *, "Call sequence information: inifilr"
71 guez 3
72 guez 154 CALL inifgn(eignvl, eignfnu, eignfnv)
73 guez 3
74 guez 54 ! Calcul de colat0
75 guez 143 forall (j = 1:jjm) dlatu(j) = rlatu(j) - rlatu(j + 1)
76     colat0 = min(0.5, minval(dlatu) / minval(xprimu(:iim)))
77 guez 54 PRINT *, 'colat0 = ', colat0
78 guez 3
79 guez 164 rlamda = iim / (pi * colat0 / grossismx) / sqrt(- eignvl(2: iim))
80 guez 166 call new_unit(unit)
81     open(unit, file = "modfrst.csv", status = "replace", action = "write")
82     write(unit, fmt = *) '"rlat (degrees)" modfrst' ! title line
83 guez 3
84 guez 166 ! D\'etermination de jfilt[ns][uv] :
85 guez 3
86 guez 167 j1 = ifirstloc(rlatu <= 0.)
87 guez 3
88 guez 167 call inifilr_hemisph(rlatu(j1 - 1:2:- 1), colat0, rlamda, unit, eignfnv, &
89 guez 166 jfiltnu, matriceun, matrinvn)
90 guez 167 jfiltnu = j1 - jfiltnu
91 guez 166 matriceun = matriceun(:, :, jfiltnu - 1:1:- 1)
92     matrinvn = matrinvn(:, :, jfiltnu - 1:1:- 1)
93 guez 3
94 guez 167 call inifilr_hemisph(- rlatu(j1:jjm), colat0, rlamda, unit, eignfnv, &
95 guez 166 jfiltsu, matriceus, matrinvs)
96 guez 167 jfiltsu = j1 - 1 + jfiltsu
97 guez 3
98 guez 167 j1 = ifirstloc(rlatv <= 0.)
99 guez 3
100 guez 167 call inifilr_hemisph(rlatv(j1 - 1:1:- 1), colat0, rlamda, unit, eignfnu, &
101 guez 166 jfiltnv, matricevn)
102 guez 167 jfiltnv = j1 - jfiltnv
103 guez 166 matricevn = matricevn(:, :, jfiltnv:1:- 1)
104 guez 3
105 guez 167 call inifilr_hemisph(- rlatv(j1:jjm), colat0, rlamda, unit, eignfnu, &
106 guez 166 jfiltsv, matricevs)
107 guez 167 jfiltsv = j1 - 1 + jfiltsv
108 guez 3
109 guez 166 close(unit)
110 guez 151 PRINT *, 'jfiltnu =', jfiltnu
111     PRINT *, 'jfiltsu =', jfiltsu
112     PRINT *, 'jfiltnv =', jfiltnv
113     PRINT *, 'jfiltsv =', jfiltsv
114 guez 3
115 guez 54 END SUBROUTINE inifilr
116 guez 32
117 guez 54 end module inifilr_m
  ViewVC Help
Powered by ViewVC 1.1.21