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