source: LMDZ.3.3/trunk/libf/phylmd/ecrireg.F @ 3

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