| 1 | C |
|---|
| 2 | C $Header$ |
|---|
| 3 | C |
|---|
| 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 | c |
|---|
| 37 | INTEGER jjm , jdatmax, jmodmax |
|---|
| 38 | REAL yjdatt( 1 ) , fdatt( 1 ) |
|---|
| 39 | REAL yjmodd( 1 ) |
|---|
| 40 | |
|---|
| 41 | c .... Arguments en sortie ....... |
|---|
| 42 | c |
|---|
| 43 | REAL fmod( 1 ) |
|---|
| 44 | c |
|---|
| 45 | c ...... Variables locales ...... |
|---|
| 46 | LOGICAL decrois |
|---|
| 47 | SAVE decrois |
|---|
| 48 | |
|---|
| 49 | REAL y0,dy,dym |
|---|
| 50 | INTEGER jdat, jmod,i |
|---|
| 51 | |
|---|
| 52 | INTEGER jmods |
|---|
| 53 | REAL , ALLOCATABLE :: fdat(:) |
|---|
| 54 | REAL , ALLOCATABLE :: yjdat(:) |
|---|
| 55 | REAL , ALLOCATABLE :: yjmod(:) |
|---|
| 56 | REAL , ALLOCATABLE :: fscrat(:) |
|---|
| 57 | ALLOCATE (fdat(jdatmax+1)) |
|---|
| 58 | ALLOCATE (yjdat(jdatmax+1)) |
|---|
| 59 | ALLOCATE (yjmod(jmodmax)) |
|---|
| 60 | ALLOCATE (fscrat(jdatmax+1)) |
|---|
| 61 | c |
|---|
| 62 | |
|---|
| 63 | DO i = 1, jdatmax +1 |
|---|
| 64 | fdat (i) = fdatt (i) |
|---|
| 65 | ENDDO |
|---|
| 66 | |
|---|
| 67 | CALL ord_coord ( jdatmax , yjdatt(1), yjdat(1), decrois ) |
|---|
| 68 | |
|---|
| 69 | IF( decrois ) THEN |
|---|
| 70 | DO i = 1,jdatmax + 1 |
|---|
| 71 | fscrat(i) = fdat(i) |
|---|
| 72 | ENDDO |
|---|
| 73 | DO i = 1, jdatmax + 1 |
|---|
| 74 | fdat(i) = fscrat( jdatmax + 2 -i ) |
|---|
| 75 | ENDDO |
|---|
| 76 | |
|---|
| 77 | ENDIF |
|---|
| 78 | |
|---|
| 79 | CALL ord_coordm (jmodmax,yjmodd(1),yjmod(1),jjm,jmods,decrois ) |
|---|
| 80 | c |
|---|
| 81 | c Initialisation des variables |
|---|
| 82 | c -------------------------------- |
|---|
| 83 | |
|---|
| 84 | DO jmod = 1, jmods |
|---|
| 85 | fmod(jmod) = 0. |
|---|
| 86 | END DO |
|---|
| 87 | |
|---|
| 88 | y0 = 0. |
|---|
| 89 | dym = 0. |
|---|
| 90 | jmod = 1 |
|---|
| 91 | jdat = 1 |
|---|
| 92 | c -------------------- |
|---|
| 93 | c Iteration |
|---|
| 94 | c -------------------- |
|---|
| 95 | |
|---|
| 96 | 100 IF ( yjmod(jmod).LT.yjdat(jdat) ) THEN |
|---|
| 97 | dy = yjmod(jmod) - y0 |
|---|
| 98 | dym = dym + dy |
|---|
| 99 | fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym |
|---|
| 100 | y0 = yjmod(jmod) |
|---|
| 101 | dym = 0. |
|---|
| 102 | jmod = jmod + 1 |
|---|
| 103 | GO TO 100 |
|---|
| 104 | |
|---|
| 105 | ELSE IF ( yjmod(jmod).GT.yjdat(jdat) ) THEN |
|---|
| 106 | dy = yjdat(jdat) - y0 |
|---|
| 107 | dym = dym + dy |
|---|
| 108 | fmod(jmod) = fmod(jmod) + dy * fdat(jdat) |
|---|
| 109 | y0 = yjdat(jdat) |
|---|
| 110 | jdat = jdat + 1 |
|---|
| 111 | |
|---|
| 112 | GO TO 100 |
|---|
| 113 | |
|---|
| 114 | ELSE |
|---|
| 115 | dy = yjmod(jmod) - y0 |
|---|
| 116 | dym = dym + dy |
|---|
| 117 | fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym |
|---|
| 118 | y0 = yjmod(jmod) |
|---|
| 119 | dym = 0. |
|---|
| 120 | jmod = jmod + 1 |
|---|
| 121 | jdat = jdat + 1 |
|---|
| 122 | |
|---|
| 123 | IF ( jmod.LE.jmods ) GO TO 100 |
|---|
| 124 | END IF |
|---|
| 125 | c --------------------------------------------- |
|---|
| 126 | c Le test de fin suppose que l'interface 0 |
|---|
| 127 | c est commune aux deux grilles yjdat et yjmod. |
|---|
| 128 | c ---------------------------------------------- |
|---|
| 129 | IF( decrois ) THEN |
|---|
| 130 | DO i = 1,jmods |
|---|
| 131 | fscrat(i) = fmod(i) |
|---|
| 132 | ENDDO |
|---|
| 133 | DO i = 1, jmods |
|---|
| 134 | fmod(i) = fscrat( jmods + 1 -i ) |
|---|
| 135 | ENDDO |
|---|
| 136 | ENDIF |
|---|
| 137 | |
|---|
| 138 | DEALLOCATE(fdat) |
|---|
| 139 | DEALLOCATE(yjdat) |
|---|
| 140 | DEALLOCATE(yjmod) |
|---|
| 141 | DEALLOCATE(fscrat) |
|---|
| 142 | |
|---|
| 143 | RETURN |
|---|
| 144 | END |
|---|
