[259] | 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 ....... |
---|
[269] | 33 | |
---|
[259] | 34 | INTEGER jjm , jdatmax, jmodmax |
---|
[269] | 35 | REAL yjdatt( jdatmax ) , fdatt( jdatmax +1 ) |
---|
| 36 | REAL yjmodd( jmodmax ) |
---|
[259] | 37 | |
---|
| 38 | c .... Arguments en sortie ....... |
---|
| 39 | c |
---|
[359] | 40 | REAL fmod( jmodmax + 1 ) |
---|
[259] | 41 | c |
---|
| 42 | c ...... Variables locales ...... |
---|
[269] | 43 | |
---|
| 44 | INTEGER jmods |
---|
| 45 | |
---|
| 46 | REAL yjdat ( jdatmax +1 ), fdat( jdatmax +1) |
---|
| 47 | REAL fscrat( jdatmax +1 ) |
---|
| 48 | REAL yjmod ( jmodmax +1 ) |
---|
[259] | 49 | LOGICAL decrois |
---|
| 50 | SAVE decrois |
---|
[269] | 51 | c |
---|
[259] | 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 |
---|