1 | SUBROUTINE inter_bary( jjm, jdatmax, yjdatt, fdatt , |
---|
2 | , jmodmax, yjmodd, fmod ) |
---|
3 | c |
---|
4 | c ... Auteurs : Robert Sadourny , P. Le Van ... |
---|
5 | c |
---|
6 | IMPLICIT NONE |
---|
7 | |
---|
8 | c ---------------------------------------------------------- |
---|
9 | c INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES . |
---|
10 | c VERSION UNIDIMENSIONNELLE , EN LATITUDE . |
---|
11 | c ---------------------------------------------------------- |
---|
12 | c |
---|
13 | c jdat : indice du champ de donnees, de 1 a jdatmax |
---|
14 | c jmod : indice du champ du modele, de 1 a jmodmax |
---|
15 | c fdatt(jdatmax) : champ de donnees (entrees) |
---|
16 | c yjdatt(jdatmax): ordonnees des interfaces des mailles donnees |
---|
17 | c yjmodd(jmodmax): ordonnees des interfaces des mailles modele |
---|
18 | c fmod(jmodmax) : champ du modele (sorties) |
---|
19 | c |
---|
20 | c ( L'indice 1 correspond a l'interface maille 1 / maille 2) |
---|
21 | c ( Les ordonnees sont exprimees en degres) |
---|
22 | c |
---|
23 | c jdatmax = nb. d'interfaces donnees = nombre de donnees - 1 |
---|
24 | c jmodmax = nb. d'interfaces modele |
---|
25 | |
---|
26 | c Si jmodmax = jjm , on veut interpoler sur les jjm+1 latitudes |
---|
27 | c rlatu du modele ( lat. des scalaires et de U ) |
---|
28 | c |
---|
29 | c Si jmodmax = jjp1 , on veut interpoler sur les jjm latitudes |
---|
30 | c rlatv du modele ( lat. de V ) |
---|
31 | |
---|
32 | c .... Arguments en entree ....... |
---|
33 | |
---|
34 | INTEGER jjm , jdatmax, jmodmax |
---|
35 | REAL yjdatt( jdatmax ) , fdatt( jdatmax +1 ) |
---|
36 | REAL yjmodd( jmodmax ) |
---|
37 | |
---|
38 | c .... Arguments en sortie ....... |
---|
39 | c |
---|
40 | REAL fmod( jmodmax + 1 ) |
---|
41 | c |
---|
42 | c ...... Variables locales ...... |
---|
43 | |
---|
44 | INTEGER jmods |
---|
45 | |
---|
46 | REAL yjdat ( jdatmax +1 ), fdat( jdatmax +1) |
---|
47 | REAL fscrat( jdatmax +1 ) |
---|
48 | REAL yjmod ( jmodmax +1 ) |
---|
49 | LOGICAL decrois |
---|
50 | SAVE decrois |
---|
51 | c |
---|
52 | REAL y0,dy,dym |
---|
53 | INTEGER jdat, jmod,i |
---|
54 | c |
---|
55 | |
---|
56 | DO i = 1, jdatmax +1 |
---|
57 | fdat (i) = fdatt (i) |
---|
58 | ENDDO |
---|
59 | |
---|
60 | CALL ord_coord ( jdatmax , yjdatt(1), yjdat(1), decrois ) |
---|
61 | |
---|
62 | IF( decrois ) THEN |
---|
63 | DO i = 1,jdatmax + 1 |
---|
64 | fscrat(i) = fdat(i) |
---|
65 | ENDDO |
---|
66 | DO i = 1, jdatmax + 1 |
---|
67 | fdat(i) = fscrat( jdatmax + 2 -i ) |
---|
68 | ENDDO |
---|
69 | |
---|
70 | ENDIF |
---|
71 | |
---|
72 | CALL ord_coordm (jmodmax,yjmodd(1),yjmod(1),jjm,jmods,decrois ) |
---|
73 | c |
---|
74 | c Initialisation des variables |
---|
75 | c -------------------------------- |
---|
76 | |
---|
77 | DO jmod = 1, jmods |
---|
78 | fmod(jmod) = 0. |
---|
79 | END DO |
---|
80 | |
---|
81 | y0 = 0. |
---|
82 | dym = 0. |
---|
83 | jmod = 1 |
---|
84 | jdat = 1 |
---|
85 | c -------------------- |
---|
86 | c Iteration |
---|
87 | c -------------------- |
---|
88 | |
---|
89 | 100 IF ( yjmod(jmod).LT.yjdat(jdat) ) THEN |
---|
90 | dy = yjmod(jmod) - y0 |
---|
91 | dym = dym + dy |
---|
92 | fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym |
---|
93 | y0 = yjmod(jmod) |
---|
94 | dym = 0. |
---|
95 | jmod = jmod + 1 |
---|
96 | GO TO 100 |
---|
97 | |
---|
98 | ELSE IF ( yjmod(jmod).GT.yjdat(jdat) ) THEN |
---|
99 | dy = yjdat(jdat) - y0 |
---|
100 | dym = dym + dy |
---|
101 | fmod(jmod) = fmod(jmod) + dy * fdat(jdat) |
---|
102 | y0 = yjdat(jdat) |
---|
103 | jdat = jdat + 1 |
---|
104 | |
---|
105 | GO TO 100 |
---|
106 | |
---|
107 | ELSE |
---|
108 | dy = yjmod(jmod) - y0 |
---|
109 | dym = dym + dy |
---|
110 | fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym |
---|
111 | y0 = yjmod(jmod) |
---|
112 | dym = 0. |
---|
113 | jmod = jmod + 1 |
---|
114 | jdat = jdat + 1 |
---|
115 | |
---|
116 | IF ( jmod.LE.jmods ) GO TO 100 |
---|
117 | END IF |
---|
118 | c --------------------------------------------- |
---|
119 | c Le test de fin suppose que l'interface 0 |
---|
120 | c est commune aux deux grilles yjdat et yjmod. |
---|
121 | c ---------------------------------------------- |
---|
122 | IF( decrois ) THEN |
---|
123 | DO i = 1,jmods |
---|
124 | fscrat(i) = fmod(i) |
---|
125 | ENDDO |
---|
126 | DO i = 1, jmods |
---|
127 | fmod(i) = fscrat( jmods + 1 -i ) |
---|
128 | ENDDO |
---|
129 | ENDIF |
---|
130 | |
---|
131 | RETURN |
---|
132 | END |
---|