source: LMDZ.3.3/trunk/libf/dyn3d/inter_barxy.F @ 259

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

Nouveaux programmes pour la creation des etats initiaux et des conditions aux limites. 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: 1.6 KB
Line 
1C
2C $Header$
3C
4       SUBROUTINE inter_barxy ( interfd,jnterfd,dlonid,dlatid ,
5     ,        champ,imod,jmod,rlonimod,rlatimod, jsort,champint )
6
7c    Auteur :   P. Le Van
8c
9       INTEGER interfd,jnterfd,imod,jmod
10       REAL champ(interfd,jnterfd +1 ),dlonid(interfd),dlatid(jnterfd),
11     ,      champint(imod,jsort)
12       REAL rlonimod(imod),rlatimod(jmod)
13
14#include "dimensions.h"
15#include "paramet.h"
16#include "comgeom2.h"
17
18       REAL champx(iip1),chpn(iip1),chps(iip1)
19       REAL chhpn,chhps
20       REAL fmody(jjp1)
21       INTEGER jmp1
22   
23       REAL,ALLOCATABLE :: champy(:,:)
24       ALLOCATE(champy(jnterfd+1,iip1))
25c
26
27       DO j = 1, jnterfd + 1
28        CALL inter_barx( interfd, dlonid, champ( 1,j ),
29     ,                       imod, rlonimod , champx )
30       
31         DO i = 1,imod
32           champy(j,i) = champx(i)
33         ENDDO
34       ENDDO
35
36       DO i = 1, imod
37        CALL inter_bary( jjm,jnterfd,dlatid,champy(1,i),
38     ,                        jmod ,rlatimod,  fmody     )
39          DO j = 1, jsort
40           champint(i,j) = fmody(j)
41          ENDDO
42       ENDDO
43
44       IF( jsort.EQ.jjp1)  THEN
45
46c   ....  Valeurs uniques  aux  poles ....
47c
48         DO i =  1,imod
49          chpn(i)  = aire( i,  1   ) * champint( i, 1   )
50          chps(i)  = aire( i, jjp1 ) * champint( i,jjp1 )
51         ENDDO
52          chhpn  = SSUM(imod,chpn,1)/apoln
53          chhps  = SSUM(imod,chps,1)/apols
54
55         DO i = 1, imod
56          champint( i,  1  ) = chhpn
57          champint( i, jjp1) = chhps
58         ENDDO
59c
60       ENDIF
61
62         DEALLOCATE(champy)
63
64       RETURN
65       END
66
Note: See TracBrowser for help on using the repository browser.