My Project
 All Classes Files Functions Variables Macros
ecribin.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4  SUBROUTINE ecribins(unit,pz)
5  USE dimphy
6  IMPLICIT none
7 c-----------------------------------------------------------------------
8 #include "dimensions.h"
9 cccc#include "dimphy.h"
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)
47  USE dimphy
48  IMPLICIT none
49 c-----------------------------------------------------------------------
50 #include "dimensions.h"
51 cccc#include "dimphy.h"
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
96  REAL(KIND=8) r8(n)
97  REAL r4(n)
98  DO i = 1, n
99  r4(i) = r8(i)
100  ENDDO
101  WRITE(nunit)r4
102  RETURN
103  END
104 #endif