source: LMDZ.3.3/trunk/libf/dyn3d/inter_bary.F @ 1611

Last change on this file since 1611 was 269, checked in by lmdz, 23 years ago

Remplacement des allocates par des dimensionnements classiques. LeVan?
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 3.7 KB
RevLine 
[259]1       SUBROUTINE inter_bary( jjm, jdatmax, yjdatt, fdatt  ,
2     ,                       jmodmax, yjmodd,  fmod      )
3c
4c    ...  Auteurs :  Robert Sadourny  , P. Le Van ...
5c
6       IMPLICIT NONE
7
8c  ----------------------------------------------------------
9c       INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES  .
10c         VERSION UNIDIMENSIONNELLE  ,    EN LATITUDE  .
11c  ----------------------------------------------------------
12c
13c     jdat : indice du champ de donnees, de 1 a jdatmax
14c     jmod : indice du champ du modele,  de 1 a jmodmax
15c     fdatt(jdatmax) : champ de donnees (entrees)
16c     yjdatt(jdatmax): ordonnees des interfaces des mailles donnees
17c     yjmodd(jmodmax): ordonnees des interfaces des mailles modele
18c     fmod(jmodmax)  : champ du modele  (sorties)
19c
20c      ( L'indice 1 correspond a l'interface maille 1 / maille 2)
21c      ( Les ordonnees sont exprimees en degres)
22c
23c     jdatmax = nb. d'interfaces  donnees =  nombre de donnees - 1
24c     jmodmax = nb. d'interfaces  modele
25
26c     Si jmodmax = jjm , on veut interpoler sur les jjm+1 latitudes
27c       rlatu   du modele ( lat.  des scalaires et de U )
28c
29c     Si jmodmax = jjp1 , on veut interpoler sur les jjm latitudes
30c       rlatv du modele  ( lat.  de  V )
31
32c  ....  Arguments  en entree  .......
[269]33
[259]34       INTEGER jjm , jdatmax, jmodmax
[269]35       REAL    yjdatt( jdatmax ) , fdatt( jdatmax +1 )
36       REAL    yjmodd( jmodmax )     
[259]37
38c  ....  Arguments  en sortie  .......
39c
40       REAL    fmod( 1 )
41c
42c   ...... Variables locales  ......
[269]43
44       INTEGER      jmods
45
46       REAL       yjdat ( jdatmax +1 ), fdat( jdatmax +1)
47       REAL       fscrat( jdatmax +1 )
48       REAL       yjmod ( jmodmax +1 )
[259]49       LOGICAL    decrois
50       SAVE       decrois
[269]51c
[259]52       REAL y0,dy,dym
53       INTEGER jdat, jmod,i
54c
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 )
73c
74c      Initialisation des variables
75c    --------------------------------
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
85c  --------------------
86c      Iteration
87c  --------------------
88
89100    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
118c   ---------------------------------------------
119c    Le test de fin suppose que l'interface 0
120c    est commune aux deux grilles yjdat et yjmod.
121c   ----------------------------------------------
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
Note: See TracBrowser for help on using the repository browser.