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