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

Diff of /trunk/filtrez/inifilr.f

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

trunk/Sources/filtrez/inifilr.f revision 168 by guez, Wed Sep 9 10:41:47 2015 UTC trunk/filtrez/inifilr.f revision 313 by guez, Mon Dec 10 15:54:30 2018 UTC
# Line 2  module inifilr_m Line 2  module inifilr_m
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
   ! North:  
   
5    INTEGER jfiltnu, jfiltnv    INTEGER jfiltnu, jfiltnv
6    ! index of the last scalar line filtered in northern hemisphere    ! index of the last line filtered in northern hemisphere at rlat[uv]
7      ! latitudes
   real, pointer:: matriceun(:, :, :) ! (iim, iim, jfiltnu - 1)  
   ! matrice filtre pour les champs situes sur la grille scalaire  
   
   real, pointer:: matrinvn(:, :, :) ! (iim, iim, jfiltnu - 1)  
   ! matrice filtre pour les champs situes sur la grille scalaire, pour  
   ! le filtre inverse  
   
   real, pointer:: matricevn(:, :, :) ! (iim, iim, jfiltnv)  
   ! matrice filtre pour les champs situes sur la grille de V ou de Z  
   
   ! South:  
8    
9    integer jfiltsu, jfiltsv    integer jfiltsu, jfiltsv
10    ! index of the first line filtered in southern hemisphere    ! index of the first line filtered in southern hemisphere at
11      ! rlat[uv] latitudes
12    
13      ! Filtre pour les champs situes sur la grille scalaire (longitudes
14      ! rlonv, latitudes rlatu) :
15      real, pointer:: matriceun(:, :, :) ! (iim, iim, jfiltnu - 1)
16    real, pointer:: matriceus(:, :, :) ! (iim, iim, jjm - jfiltsu + 1)    real, pointer:: matriceus(:, :, :) ! (iim, iim, jjm - jfiltsu + 1)
   ! matrice filtre pour les champs situes sur la grille scalaire  
17    
18      ! Filtre pour les champs situes sur la grille scalaire (longitudes
19      ! rlonv, latitudes rlatu), pour le filtre inverse :
20      real, pointer:: matrinvn(:, :, :) ! (iim, iim, jfiltnu - 1)
21    real, pointer:: matrinvs(:, :, :) ! (iim, iim, jjm - jfiltsu + 1)    real, pointer:: matrinvs(:, :, :) ! (iim, iim, jjm - jfiltsu + 1)
   ! matrice filtre pour les champs situes sur la grille scalaire, pour  
   ! le filtre inverse  
22    
23      ! Filtre pour les champs situes sur la grille de la vorticit\'e
24      ! (longitudes rlonu, latitudes rlatv)
25      real, pointer:: matricevn(:, :, :) ! (iim, iim, jfiltnv) matrice
26    real, pointer:: matricevs(:, :, :) ! (iim, iim, jjm - jfiltsv + 1)    real, pointer:: matricevs(:, :, :) ! (iim, iim, jjm - jfiltsv + 1)
   ! matrice filtre pour les champs situes sur la grille de V ou de Z  
27    
28  contains  contains
29    
# Line 46  contains Line 39  contains
39      ! (stretching coefficient) is set equal to zero for the regular      ! (stretching coefficient) is set equal to zero for the regular
40      ! grid case.      ! grid case.
41    
42      USE dimens_m, ONLY : iim, jjm      ! Libraries:
43      USE dynetat0_m, ONLY : rlatu, rlatv, xprimu, grossismx      use jumble, only: new_unit
44        use nr_util, only: pi, ifirstloc, assert
45    
46        USE dimensions, ONLY: iim, jjm
47        USE dynetat0_m, ONLY: rlatu, rlatv, xprimu
48        USE dynetat0_chosen_m, ONLY: grossismx
49      use inifgn_m, only: inifgn      use inifgn_m, only: inifgn
50      use inifilr_hemisph_m, only: inifilr_hemisph      use inifilr_hemisph_m, only: inifilr_hemisph
     use jumble, only: new_unit  
     use nr_util, only: pi, ifirstloc  
51    
52      ! Local:      ! Local:
53    
# Line 60  contains Line 56  contains
56      real eignvl(iim) ! eigenvalues (<= 0) sorted in descending order      real eignvl(iim) ! eigenvalues (<= 0) sorted in descending order
57      INTEGER j, unit      INTEGER j, unit
58      REAL colat0 ! > 0      REAL colat0 ! > 0
59      integer j1 ! index of smallest positive latitude      integer j1 ! index of negative latitude closest to the equator
60    
61      real eignfnu(iim, iim), eignfnv(iim, iim)      real eignfnu(iim, iim), eignfnv(iim, iim)
62      ! eigenvectors of the discrete second derivative with respect to longitude      ! eigenvectors of the discrete second derivative with respect to
63        ! longitude, at rlon[uv] longitudes
64    
65      !-----------------------------------------------------------      !-----------------------------------------------------------
66    
# Line 76  contains Line 73  contains
73      colat0 = min(0.5, minval(dlatu) / minval(xprimu(:iim)))      colat0 = min(0.5, minval(dlatu) / minval(xprimu(:iim)))
74      PRINT *, 'colat0 = ', colat0      PRINT *, 'colat0 = ', colat0
75    
76      rlamda = iim / (pi * colat0 / grossismx) / sqrt(- eignvl(2: iim))      rlamda = iim / pi / colat0 * grossismx / sqrt(- eignvl(2: iim))
77      print *, "1 / rlamda(iim) = ", 1. / rlamda(iim)      print *, "1 / rlamda(iim) = ", 1. / rlamda(iim)
78        ! This is demonstrated in the notes but just to be sure:
79        call assert(rlamda(iim) * colat0 >= 1. - 2. * epsilon(0.), &
80             "inifilr rlamda(iim) * colat0")
81    
82      call new_unit(unit)      call new_unit(unit)
83      open(unit, file = "modfrst.csv", status = "replace", action = "write")      open(unit, file = "modfrst.csv", status = "replace", action = "write")
84      write(unit, fmt = *) '"rlat (degrees)" modfrst' ! title line      write(unit, fmt = *) '"rlat (degrees)" modfrst' ! title line
85    
86      j1 = ifirstloc(rlatu <= 0.)      j1 = ifirstloc(rlatu <= 0.)
87    
88      call inifilr_hemisph(rlatu(j1 - 1:2:- 1), colat0, rlamda, unit, eignfnv, &      call inifilr_hemisph(rlatu(j1 - 1:2:- 1), rlamda, unit, eignfnv, jfiltnu, &
89           jfiltnu, matriceun, matrinvn)           matriceun, matrinvn)
90      jfiltnu = j1 - jfiltnu      jfiltnu = j1 - jfiltnu
91      matriceun = matriceun(:, :, jfiltnu - 1:1:- 1)      matriceun = matriceun(:, :, jfiltnu - 1:1:- 1)
92      matrinvn = matrinvn(:, :, jfiltnu - 1:1:- 1)      matrinvn = matrinvn(:, :, jfiltnu - 1:1:- 1)
93    
94      call inifilr_hemisph(- rlatu(j1:jjm), colat0, rlamda, unit, eignfnv, &      call inifilr_hemisph(- rlatu(j1:jjm), rlamda, unit, eignfnv, jfiltsu, &
95           jfiltsu, matriceus, matrinvs)           matriceus, matrinvs)
96      jfiltsu = j1 - 1 + jfiltsu      jfiltsu = j1 - 1 + jfiltsu
97    
98      j1 = ifirstloc(rlatv <= 0.)      j1 = ifirstloc(rlatv <= 0.)
99    
100      call inifilr_hemisph(rlatv(j1 - 1:1:- 1), colat0, rlamda, unit, eignfnu, &      call inifilr_hemisph(rlatv(j1 - 1:1:- 1), rlamda, unit, eignfnu, jfiltnv, &
101           jfiltnv, matricevn)           matricevn)
102      jfiltnv = j1 - jfiltnv      jfiltnv = j1 - jfiltnv
103      matricevn = matricevn(:, :, jfiltnv:1:- 1)      matricevn = matricevn(:, :, jfiltnv:1:- 1)
104    
105      call inifilr_hemisph(- rlatv(j1:jjm), colat0, rlamda, unit, eignfnu, &      call inifilr_hemisph(- rlatv(j1:jjm), rlamda, unit, eignfnu, jfiltsv, &
106           jfiltsv, matricevs)           matricevs)
107      jfiltsv = j1 - 1 + jfiltsv      jfiltsv = j1 - 1 + jfiltsv
108    
109      close(unit)      close(unit)
Legend:
Removed from v.168  
changed lines
  Added in v.313
  ViewVC Help
Powered by ViewVC 1.1.21