/[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

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