source: LMDZ.3.3/branches/rel-LF/libf/phylmd/ecribin.F @ 1546

Last change on this file since 1546 was 2, checked in by lmdz, 25 years ago

Initial revision

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