SUBROUTINE inter_bary( jjm, jdatmax, yjdatt, fdatt , , jmodmax, yjmodd, fmod ) c c ... Auteurs : Robert Sadourny , P. Le Van ... c IMPLICIT NONE c ---------------------------------------------------------- c INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES . c VERSION UNIDIMENSIONNELLE , EN LATITUDE . c ---------------------------------------------------------- c c jdat : indice du champ de donnees, de 1 a jdatmax c jmod : indice du champ du modele, de 1 a jmodmax c fdatt(jdatmax) : champ de donnees (entrees) c yjdatt(jdatmax): ordonnees des interfaces des mailles donnees c yjmodd(jmodmax): ordonnees des interfaces des mailles modele c fmod(jmodmax) : champ du modele (sorties) c c ( L'indice 1 correspond a l'interface maille 1 / maille 2) c ( Les ordonnees sont exprimees en degres) c c jdatmax = nb. d'interfaces donnees = nombre de donnees - 1 c jmodmax = nb. d'interfaces modele c Si jmodmax = jjm , on veut interpoler sur les jjm+1 latitudes c rlatu du modele ( lat. des scalaires et de U ) c c Si jmodmax = jjp1 , on veut interpoler sur les jjm latitudes c rlatv du modele ( lat. de V ) c .... Arguments en entree ....... INTEGER jjm , jdatmax, jmodmax REAL yjdatt( jdatmax ) , fdatt( jdatmax +1 ) REAL yjmodd( jmodmax ) c .... Arguments en sortie ....... c REAL fmod( jmodmax + 1 ) c c ...... Variables locales ...... INTEGER jmods REAL yjdat ( jdatmax +1 ), fdat( jdatmax +1) REAL fscrat( jdatmax +1 ) REAL yjmod ( jmodmax +1 ) LOGICAL decrois SAVE decrois c REAL y0,dy,dym INTEGER jdat, jmod,i c DO i = 1, jdatmax +1 fdat (i) = fdatt (i) ENDDO CALL ord_coord ( jdatmax , yjdatt(1), yjdat(1), decrois ) IF( decrois ) THEN DO i = 1,jdatmax + 1 fscrat(i) = fdat(i) ENDDO DO i = 1, jdatmax + 1 fdat(i) = fscrat( jdatmax + 2 -i ) ENDDO ENDIF CALL ord_coordm (jmodmax,yjmodd(1),yjmod(1),jjm,jmods,decrois ) c c Initialisation des variables c -------------------------------- DO jmod = 1, jmods fmod(jmod) = 0. END DO y0 = 0. dym = 0. jmod = 1 jdat = 1 c -------------------- c Iteration c -------------------- 100 IF ( yjmod(jmod).LT.yjdat(jdat) ) THEN dy = yjmod(jmod) - y0 dym = dym + dy fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym y0 = yjmod(jmod) dym = 0. jmod = jmod + 1 GO TO 100 ELSE IF ( yjmod(jmod).GT.yjdat(jdat) ) THEN dy = yjdat(jdat) - y0 dym = dym + dy fmod(jmod) = fmod(jmod) + dy * fdat(jdat) y0 = yjdat(jdat) jdat = jdat + 1 GO TO 100 ELSE dy = yjmod(jmod) - y0 dym = dym + dy fmod(jmod) = (fmod(jmod) + dy * fdat(jdat)) / dym y0 = yjmod(jmod) dym = 0. jmod = jmod + 1 jdat = jdat + 1 IF ( jmod.LE.jmods ) GO TO 100 END IF c --------------------------------------------- c Le test de fin suppose que l'interface 0 c est commune aux deux grilles yjdat et yjmod. c ---------------------------------------------- IF( decrois ) THEN DO i = 1,jmods fscrat(i) = fmod(i) ENDDO DO i = 1, jmods fmod(i) = fscrat( jmods + 1 -i ) ENDDO ENDIF RETURN END