source: LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/ecrireg.F @ 4463

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