/[lmdze]/trunk/dyn3d/Inter_barxy/inter_barx.f
ViewVC logotype

Diff of /trunk/dyn3d/Inter_barxy/inter_barx.f

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

trunk/dyn3d/Inter_barxy/inter_barx.f revision 98 by guez, Tue May 13 17:23:16 2014 UTC trunk/Sources/dyn3d/Inter_barxy/inter_barx.f revision 225 by guez, Mon Oct 16 12:35:41 2017 UTC
# Line 4  module inter_barx_m Line 4  module inter_barx_m
4    
5  contains  contains
6    
   
   !******************************  
   
7    function inter_barx(dlonid, fdat, rlonimod)    function inter_barx(dlonid, fdat, rlonimod)
8    
9      ! From dyn3d/inter_barx.F, v 1.1.1.1 2004/05/19 12:53:06      ! From dyn3d/inter_barx.F, version 1.1.1.1, 2004/05/19 12:53:06
   
     ! Auteurs : Robert Sadourny, P. Le Van  
   
     !        INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES  
     !            VERSION UNIDIMENSIONNELLE  ,   EN  LONGITUDE .  
10    
11      !     idat : indice du champ de donnees, de 1 a idatmax      ! Authors: Robert Sadourny, P. Le Van
     !     imod : indice du champ du modele,  de 1 a  imodmax  
     !     fdat(idat) : champ de donnees (entrees)  
     !     inter_barx(imod) : champ du modele (sorties)  
     !     dlonid(idat): abscisses des interfaces des mailles donnees  
     !     rlonimod(imod): abscisses des interfaces des mailles modele  
     !      ( L'indice 1 correspond a l'interface mailLE 1 / maille 2)  
     !      ( Les abscisses sont exprimées en degres)  
12    
13      use nr_util, only: assert_eq      ! INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES
14        ! VERSION UNIDIMENSIONNELLE, EN LONGITUDE .
15    
16        use nr_util, only: assert_eq, pi
17    
18      REAL, intent(in):: dlonid(:)      REAL, intent(in):: dlonid(:) ! (idatmax)
19      real, intent(in):: fdat(:)      ! abscisses des interfaces des mailles donnees
20      real, intent(in):: rlonimod(:)      
21        real, intent(in):: fdat(:) ! (idatmax) champ de donnees
22    
23      real inter_barx(size(rlonimod))      real, intent(in):: rlonimod(:) ! (imodmax)
24        ! Abscisses des interfaces des mailles modele. L'indice 1
25        ! correspond a l'interface mailLE 1 / maille 2. Les abscisses sont
26        ! exprim\'ees en degres.
27    
28      !    ...  Variables locales ...      real inter_barx(size(rlonimod)) ! champ du modele
29    
30        ! Local:
31      INTEGER idatmax, imodmax      INTEGER idatmax, imodmax
32      REAL xxid(size(dlonid)+1), xxd(size(dlonid)+1), fdd(size(dlonid)+1)      REAL xxid(size(dlonid)+1), xxd(size(dlonid)+1), fdd(size(dlonid)+1)
33      REAL  fxd(size(dlonid)+1), xchan(size(dlonid)+1), fdchan(size(dlonid)+1)      REAL fxd(size(dlonid)+1), xchan(size(dlonid)+1), fdchan(size(dlonid)+1)
34      REAL  xxim(size(rlonimod))      REAL xxim(size(rlonimod))
   
35      REAL x0, xim0, dx, dxm      REAL x0, xim0, dx, dxm
36      REAL chmin, chmax, pi      REAL chmax
37        integer idat ! indice du champ de donnees, de 1 a idatmax
38      INTEGER imod, idat, i, ichang, id0, id1, nid, idatmax1      INTEGER imod ! indice du champ du modele, de 1 a imodmax
39        integer i, ichang, id0, id1, nid, idatmax1
40    
41      !-----------------------------------------------------      !-----------------------------------------------------
42    
43      idatmax = assert_eq(size(dlonid), size(fdat), "inter_barx idatmax")      idatmax = assert_eq(size(dlonid), size(fdat), "inter_barx idatmax")
44      imodmax = size(rlonimod)      imodmax = size(rlonimod)
45    
46      pi = 2. * ASIN(1.)      ! REDEFINITION DE L'ORIGINE DES ABSCISSES
47        ! A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE
     !   REDEFINITION DE L'ORIGINE DES ABSCISSES  
     !    A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE  
48      DO imod = 1, imodmax      DO imod = 1, imodmax
49         xxim(imod) = rlonimod(imod)         xxim(imod) = rlonimod(imod)
50      ENDDO      ENDDO
51    
52      CALL minmax( imodmax, xxim, chmin, chmax)      chmax = maxval(xxim)
53      IF( chmax.LT.6.50 )   THEN      IF(chmax < 6.50) THEN
54         DO imod = 1, imodmax         DO imod = 1, imodmax
55            xxim(imod) = xxim(imod) * 180./pi            xxim(imod) = xxim(imod) * 180./pi
56         ENDDO         ENDDO
# Line 78  contains Line 68  contains
68         xxd(idat) = dlonid(idat)         xxd(idat) = dlonid(idat)
69      ENDDO      ENDDO
70    
71      CALL minmax( idatmax, xxd, chmin, chmax)      chmax = maxval(xxd(:idatmax))
72      IF( chmax.LT.6.50 )  THEN      IF(chmax < 6.50) THEN
73         DO idat = 1, idatmax         DO idat = 1, idatmax
74            xxd(idat) = xxd(idat) * 180./pi            xxd(idat) = xxd(idat) * 180./pi
75         ENDDO         ENDDO
76      ENDIF      ENDIF
77    
78      DO idat = 1, idatmax      DO idat = 1, idatmax
79         xxd(idat) = AMOD( xxd(idat) - xim0, 360. )         xxd(idat) = AMOD(xxd(idat) - xim0, 360.)
80         fdd(idat) = fdat (idat)         fdd(idat) = fdat (idat)
81      ENDDO      ENDDO
82    
# Line 96  contains Line 86  contains
86      ENDDO      ENDDO
87      IF (xxd(i) < xxd(i-1)) THEN      IF (xxd(i) < xxd(i-1)) THEN
88         ichang = i         ichang = i
89         !  ***  reorganisation  des longitudes entre 0. et 360. degres ****         ! *** reorganisation des longitudes entre 0. et 360. degres ****
90         nid = idatmax - ichang +1         nid = idatmax - ichang +1
91         DO i = 1, nid         DO i = 1, nid
92            xchan (i) = xxd(i+ichang -1 )            xchan (i) = xxd(i+ichang -1)
93            fdchan(i) = fdd(i+ichang -1 )            fdchan(i) = fdd(i+ichang -1)
94         ENDDO         ENDDO
95         DO i=1, ichang -1         DO i=1, ichang -1
96            xchan (i+ nid) = xxd(i)            xchan (i+ nid) = xxd(i)
# Line 112  contains Line 102  contains
102         ENDDO         ENDDO
103      end IF      end IF
104    
105      !    translation des champs de donnees par rapport      ! translation des champs de donnees par rapport
106      !    a la nouvelle origine, avec redondance de la      ! a la nouvelle origine, avec redondance de la
107      !       maille a cheval sur les bords      ! maille a cheval sur les bords
108    
109      id0 = 0      id0 = 0
110      id1 = 0      id1 = 0
111    
112      DO idat = 1, idatmax      DO idat = 1, idatmax
113         IF ( xxd( idatmax1- idat ).LT.360.) exit         IF (xxd(idatmax1- idat) < 360.) exit
114         id1 = id1 + 1         id1 = id1 + 1
115      ENDDO      ENDDO
116    
117      DO idat = 1, idatmax      DO idat = 1, idatmax
118         IF (xxd(idat).GT.0.) exit         IF (xxd(idat) > 0.) exit
119         id0 = id0 + 1         id0 = id0 + 1
120      END DO      END DO
121    
122      IF( id1 /= 0 ) then      IF(id1 /= 0) then
123         DO idat = 1, id1         DO idat = 1, id1
124            xxid(idat) = xxd(idatmax - id1 + idat) - 360.            xxid(idat) = xxd(idatmax - id1 + idat) - 360.
125            fxd (idat) = fdd(idatmax - id1 + idat)            fxd (idat) = fdd(idatmax - id1 + idat)
# Line 147  contains Line 137  contains
137         END DO         END DO
138    
139         DO idat = 1, id0         DO idat = 1, id0
140            xxid (idatmax - id0 + idat) =  xxd(idat) + 360.            xxid (idatmax - id0 + idat) = xxd(idat) + 360.
141            fxd  (idatmax - id0 + idat) =  fdd(idat)            fxd (idatmax - id0 + idat) = fdd(idat)
142         END DO         END DO
143      else      else
144         DO idat = 1, idatmax         DO idat = 1, idatmax
145            xxid(idat)  = xxd(idat)            xxid(idat) = xxd(idat)
146            fxd (idat)  = fdd(idat)            fxd (idat) = fdd(idat)
147         ENDDO         ENDDO
148      end IF      end IF
149      xxid(idatmax1) = xxid(1) + 360.      xxid(idatmax1) = xxid(1) + 360.
150      fxd (idatmax1) = fxd(1)      fxd (idatmax1) = fxd(1)
151    
152      !   initialisation du champ du modele      ! initialisation du champ du modele
153    
154      inter_barx(:) = 0.      inter_barx(:) = 0.
155    
156      ! iteration      ! iteration
157    
158      x0   = xim0      x0 = xim0
159      dxm  = 0.      dxm = 0.
160      imod = 1      imod = 1
161      idat = 1      idat = 1
162    
163      do while (imod <= imodmax)      do while (imod <= imodmax)
164         do while (xxim(imod).GT.xxid(idat))         do while (xxim(imod) > xxid(idat))
165            dx   = xxid(idat) - x0            dx = xxid(idat) - x0
166            dxm  = dxm + dx            dxm = dxm + dx
167            inter_barx(imod) = inter_barx(imod) + dx * fxd(idat)            inter_barx(imod) = inter_barx(imod) + dx * fxd(idat)
168            x0   = xxid(idat)            x0 = xxid(idat)
169            idat = idat + 1            idat = idat + 1
170         end do         end do
171         IF (xxim(imod).LT.xxid(idat)) THEN         IF (xxim(imod) < xxid(idat)) THEN
172            dx   = xxim(imod) - x0            dx = xxim(imod) - x0
173            dxm  = dxm + dx            dxm = dxm + dx
174            inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm            inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
175            x0   = xxim(imod)            x0 = xxim(imod)
176            dxm  = 0.            dxm = 0.
177            imod = imod + 1            imod = imod + 1
178         ELSE         ELSE
179            dx   = xxim(imod) - x0            dx = xxim(imod) - x0
180            dxm  = dxm + dx            dxm = dxm + dx
181            inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm            inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
182            x0   = xxim(imod)            x0 = xxim(imod)
183            dxm  = 0.            dxm = 0.
184            imod = imod + 1            imod = imod + 1
185            idat = idat + 1            idat = idat + 1
186         END IF         END IF
Legend:
Removed from v.98  
changed lines
  Added in v.225
  ViewVC Help
Powered by ViewVC 1.1.21