source: LMDZ4/branches/LMDZ4-dev-20091210/libf/dyn3dpar/inter_bary.F @ 5415

Last change on this file since 5415 was 774, checked in by Laurent Fairhead, 18 years ago

Suite du merge entre la version et la HEAD: quelques modifications de
Yann sur le

LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.7 KB
Line 
1!
2! $Header$
3!
4       SUBROUTINE inter_bary( jjm, jdatmax, yjdatt, fdatt  ,
5     ,                       jmodmax, yjmodd,  fmod      )
6c
7c    ...  Auteurs :  Robert Sadourny  , P. Le Van ...
8c
9       IMPLICIT NONE
10
11c  ----------------------------------------------------------
12c       INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES  .
13c         VERSION UNIDIMENSIONNELLE  ,    EN LATITUDE  .
14c  ----------------------------------------------------------
15c
16c     jdat : indice du champ de donnees, de 1 a jdatmax
17c     jmod : indice du champ du modele,  de 1 a jmodmax
18c     fdatt(jdatmax) : champ de donnees (entrees)
19c     yjdatt(jdatmax): ordonnees des interfaces des mailles donnees
20c     yjmodd(jmodmax): ordonnees des interfaces des mailles modele
21c     fmod(jmodmax)  : champ du modele  (sorties)
22c
23c      ( L'indice 1 correspond a l'interface maille 1 / maille 2)
24c      ( Les ordonnees sont exprimees en degres)
25c
26c     jdatmax = nb. d'interfaces  donnees =  nombre de donnees - 1
27c     jmodmax = nb. d'interfaces  modele
28
29c     Si jmodmax = jjm , on veut interpoler sur les jjm+1 latitudes
30c       rlatu   du modele ( lat.  des scalaires et de U )
31c
32c     Si jmodmax = jjp1 , on veut interpoler sur les jjm latitudes
33c       rlatv du modele  ( lat.  de  V )
34
35c  ....  Arguments  en entree  .......
36
37       INTEGER jjm , jdatmax, jmodmax
38       REAL    yjdatt( jdatmax ) , fdatt( jdatmax +1 )
39       REAL    yjmodd( jmodmax )     
40
41c  ....  Arguments  en sortie  .......
42c
43       REAL    fmod( jmodmax + 1 )
44c
45c   ...... 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
54c
55       REAL y0,dy,dym
56       INTEGER jdat, jmod,i
57c
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 )
76c
77c      Initialisation des variables
78c    --------------------------------
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
88c  --------------------
89c      Iteration
90c  --------------------
91
92100    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
121c   ---------------------------------------------
122c    Le test de fin suppose que l'interface 0
123c    est commune aux deux grilles yjdat et yjmod.
124c   ----------------------------------------------
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
Note: See TracBrowser for help on using the repository browser.