source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/ecrireg.F90 @ 3809

Last change on this file since 3809 was 3809, checked in by ymipsl, 10 years ago

Add LMDZ in aquaplanet configuration
YM

File size: 2.6 KB
Line 
1
2! $Header$
3
4SUBROUTINE ecriregs(unit, pz)
5  USE dimphy
6  IMPLICIT NONE
7  ! -----------------------------------------------------------------------
8  include "dimensions.h"
9  ! ccc#include "dimphy.h"
10  include "paramet.h"
11  include "comgeom.h"
12  include "comvert.h"
13  include "regdim.h"
14
15  ! arguments:
16  ! ----------
17  INTEGER unit
18  REAL pz(klon)
19
20  ! local:
21  ! ------
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)*(j_fin-j_deb+1))
26  REAL zzz(nleng)
27
28  ! -----------------------------------------------------------------------
29  ! passage a la grille dynamique:
30  ! ------------------------------
31  DO i = 1, iim
32    zz(i, 1) = pz(1)
33    zz(i, jjm+1) = pz(klon)
34  END DO
35
36  ! 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  END DO
41  ! -----------------------------------------------------------------------
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    END DO
48    DO i = i2_deb, i2_fin
49      ig = ig + 1
50      zzz(ig) = zz(i, j)
51    END DO
52  END DO
53#ifdef VPP
54  CALL ecriture(unit, zzz, nleng)
55#else
56  WRITE (unit) zzz
57#endif
58  RETURN
59END SUBROUTINE ecriregs
60SUBROUTINE ecrirega(unit, pz)
61  USE dimphy
62  IMPLICIT NONE
63  ! -----------------------------------------------------------------------
64  include "dimensions.h"
65  ! ccc#include "dimphy.h"
66  include "paramet.h"
67  include "comgeom.h"
68  include "comvert.h"
69  include "regdim.h"
70
71  ! arguments:
72  ! ----------
73  INTEGER unit
74  REAL pz(klon, klev)
75
76  ! local:
77  ! ------
78  INTEGER i, j, ilay, ig
79  REAL zz(iim, jjm+1, llm)
80  INTEGER nleng
81  PARAMETER (nleng=(i2_fin-i2_deb+1+i1_fin-i1_deb+1)*(j_fin-j_deb+1))
82  REAL zzz(nleng)
83  ! -----------------------------------------------------------------------
84  ! passage a la grille dynamique:
85  ! ------------------------------
86  DO ilay = 1, llm
87    ! 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    END DO
92    ! 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    END DO
97  END DO
98  ! -----------------------------------------------------------------------
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      END DO
106      DO i = i2_deb, i2_fin
107        ig = ig + 1
108        zzz(ig) = zz(i, j, ilay)
109      END DO
110    END DO
111#ifdef VPP
112    CALL ecriture(unit, zzz, nleng)
113#else
114    WRITE (unit) zzz
115#endif
116  END DO
117
118  RETURN
119END SUBROUTINE ecrirega
Note: See TracBrowser for help on using the repository browser.