source: LMDZ4/branches/IPSL-CM4_IPCC_branch/libf/phylmd/ecribin.F @ 5095

Last change on this file since 5095 was 524, checked in by lmdzadmin, 21 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.4 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE ecribins(unit,pz)
5      IMPLICIT none
6c-----------------------------------------------------------------------
7#include "dimensions.h"
8#include "dimphy.h"
9#include "paramet.h"
10#include "comgeom.h"
11#include "comvert.h"
12c
13c   arguments:
14c   ----------
15      INTEGER unit
16      REAL pz(klon)
17c
18c   local:
19c   ------
20      INTEGER i,j, ig
21      REAL zz(iim +1,jjm+1)
22c-----------------------------------------------------------------------
23c   passage a la grille dynamique:
24c   ------------------------------
25         DO i=1,iim +1
26            zz(i,1)=pz(1)
27            zz(i,jjm+1)=pz(klon)
28         ENDDO
29c   traitement des point normaux
30         DO j=2,jjm
31            ig=2+(j-2)*iim
32            CALL SCOPY(iim,pz(ig),1,zz(1,j),1)
33            zz(iim+1,j)=zz(1,j)
34         ENDDO
35c-----------------------------------------------------------------------
36#ifdef VPP
37      CALL ecriture(unit,zz,(iim+1)*(jjm+1))
38#else
39      WRITE(unit) zz
40#endif
41c
42
43      RETURN
44      END
45      SUBROUTINE ecribina(unit,pz)
46      IMPLICIT none
47c-----------------------------------------------------------------------
48#include "dimensions.h"
49#include "dimphy.h"
50#include "paramet.h"
51#include "comgeom.h"
52#include "comvert.h"
53c
54c   arguments:
55c   ----------
56      INTEGER unit
57      REAL pz(klon,klev)
58c
59c   local:
60c   ------
61      INTEGER i,j,ilay,ig
62      REAL zz(iim+1,jjm+1,llm)
63c-----------------------------------------------------------------------
64c   passage a la grille dynamique:
65c   ------------------------------
66      DO ilay=1,llm
67c   traitement des poles
68         DO i=1,iim +1
69            zz(i,1,ilay)=pz(1,ilay)
70            zz(i,jjm+1,ilay)=pz(klon,ilay)
71         ENDDO
72c   traitement des point normaux
73         DO j=2,jjm
74            ig=2+(j-2)*iim
75            CALL SCOPY(iim,pz(ig,ilay),1,zz(1,j,ilay),1)
76            zz(iim+1,j,ilay)=zz(1,j,ilay)
77         ENDDO
78      ENDDO
79c-----------------------------------------------------------------------
80      DO ilay = 1, llm
81#ifdef VPP
82         CALL ecriture(unit, zz(1,1,ilay), (iim+1)*(jjm+1))
83#else
84         WRITE(unit) ((zz(i,j,ilay),i=1,iim +1),j=1,jjm+1)
85#endif
86      ENDDO
87c
88      RETURN
89      END
90#ifdef VPP
91@OPTIONS NODOUBLE
92      SUBROUTINE ecriture(nunit, r8, n)
93      INTEGER nunit, n, i
94      REAL*8 r8(n)
95      REAL*4 r4(n)
96      DO i = 1, n
97         r4(i) = r8(i)
98      ENDDO
99      WRITE(nunit)r4
100      RETURN
101      END
102#endif
Note: See TracBrowser for help on using the repository browser.