| 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( 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 |
|---|
