My Project
 All Classes Files Functions Variables Macros
ecrireg.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4  SUBROUTINE ecriregs(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 #include "regdim.h"
14 c
15 c arguments:
16 c ----------
17  INTEGER unit
18  REAL pz(klon)
19 c
20 c local:
21 c ------
22  INTEGER i,j, ig
23  REAL zz(iim,jjm+1)
24  INTEGER nleng
25  parameter(nleng=(i2_fin-i2_deb+1+i1_fin-i1_deb+1)
26  . *(j_fin-j_deb+1))
27  REAL zzz(nleng)
28 c
29 c-----------------------------------------------------------------------
30 c passage a la grille dynamique:
31 c ------------------------------
32  DO i=1,iim
33  zz(i,1)=pz(1)
34  zz(i,jjm+1)=pz(klon)
35  ENDDO
36 c
37 c traitement des point normaux
38  DO j=2,jjm
39  ig=2+(j-2)*iim
40  CALL scopy(iim,pz(ig),1,zz(1,j),1)
41  ENDDO
42 c-----------------------------------------------------------------------
43  ig = 0
44  DO j = j_deb, j_fin
45  DO i=i1_deb,i1_fin
46  ig = ig + 1
47  zzz(ig) = zz(i,j)
48  ENDDO
49  DO i=i2_deb,i2_fin
50  ig = ig + 1
51  zzz(ig) = zz(i,j)
52  ENDDO
53  ENDDO
54 #ifdef VPP
55  CALL ecriture(unit,zzz,nleng)
56 #else
57  WRITE(unit) zzz
58 #endif
59  RETURN
60  END
61  SUBROUTINE ecrirega(unit,pz)
62  USE dimphy
63  IMPLICIT none
64 c-----------------------------------------------------------------------
65 #include "dimensions.h"
66 cccc#include "dimphy.h"
67 #include "paramet.h"
68 #include "comgeom.h"
69 #include "comvert.h"
70 #include "regdim.h"
71 c
72 c arguments:
73 c ----------
74  INTEGER unit
75  REAL pz(klon,klev)
76 c
77 c local:
78 c ------
79  INTEGER i,j,ilay,ig
80  REAL zz(iim,jjm+1,llm)
81  INTEGER nleng
82  parameter(nleng=(i2_fin-i2_deb+1+i1_fin-i1_deb+1)
83  . *(j_fin-j_deb+1))
84  REAL zzz(nleng)
85 c-----------------------------------------------------------------------
86 c passage a la grille dynamique:
87 c ------------------------------
88  DO ilay=1,llm
89 c traitement des poles
90  DO i=1,iim
91  zz(i,1,ilay)=pz(1,ilay)
92  zz(i,jjm+1,ilay)=pz(klon,ilay)
93  ENDDO
94 c traitement des point normaux
95  DO j=2,jjm
96  ig=2+(j-2)*iim
97  CALL scopy(iim,pz(ig,ilay),1,zz(1,j,ilay),1)
98  ENDDO
99  ENDDO
100 c-----------------------------------------------------------------------
101  DO ilay = 1, llm
102  ig = 0
103  DO j = j_deb, j_fin
104  DO i=i1_deb,i1_fin
105  ig = ig + 1
106  zzz(ig) = zz(i,j,ilay)
107  ENDDO
108  DO i=i2_deb,i2_fin
109  ig = ig + 1
110  zzz(ig) = zz(i,j,ilay)
111  ENDDO
112  ENDDO
113 #ifdef VPP
114  CALL ecriture(unit,zzz,nleng)
115 #else
116  WRITE(unit) zzz
117 #endif
118  ENDDO
119 
120  RETURN
121  END