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

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