LMDZ
ecrireg.F90
Go to the documentation of this file.
1 
2 ! $Header$
3 
4 SUBROUTINE 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 "regdim.h"
13 
14  ! arguments:
15  ! ----------
16  INTEGER unit
17  REAL pz(klon)
18 
19  ! local:
20  ! ------
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)*(j_fin-j_deb+1))
25  REAL zzz(nleng)
26 
27  ! -----------------------------------------------------------------------
28  ! passage a la grille dynamique:
29  ! ------------------------------
30  DO i = 1, iim
31  zz(i, 1) = pz(1)
32  zz(i, jjm+1) = pz(klon)
33  END DO
34 
35  ! traitement des point normaux
36  DO j = 2, jjm
37  ig = 2 + (j-2)*iim
38  CALL scopy(iim, pz(ig), 1, zz(1,j), 1)
39  END DO
40  ! -----------------------------------------------------------------------
41  ig = 0
42  DO j = j_deb, j_fin
43  DO i = i1_deb, i1_fin
44  ig = ig + 1
45  zzz(ig) = zz(i, j)
46  END DO
47  DO i = i2_deb, i2_fin
48  ig = ig + 1
49  zzz(ig) = zz(i, j)
50  END DO
51  END DO
52 #ifdef VPP
53  CALL ecriture(unit, zzz, nleng)
54 #else
55  WRITE (unit) zzz
56 #endif
57  RETURN
58 END SUBROUTINE ecriregs
59 SUBROUTINE ecrirega(unit, pz)
60  USE dimphy
61  IMPLICIT NONE
62  ! -----------------------------------------------------------------------
63  include "dimensions.h"
64  ! ccc#include "dimphy.h"
65  include "paramet.h"
66  include "comgeom.h"
67  include "regdim.h"
68 
69  ! arguments:
70  ! ----------
71  INTEGER unit
72  REAL pz(klon, klev)
73 
74  ! local:
75  ! ------
76  INTEGER i, j, ilay, ig
77  REAL zz(iim, jjm+1, llm)
78  INTEGER nleng
79  parameter(nleng=(i2_fin-i2_deb+1+i1_fin-i1_deb+1)*(j_fin-j_deb+1))
80  REAL zzz(nleng)
81  ! -----------------------------------------------------------------------
82  ! passage a la grille dynamique:
83  ! ------------------------------
84  DO ilay = 1, llm
85  ! traitement des poles
86  DO i = 1, iim
87  zz(i, 1, ilay) = pz(1, ilay)
88  zz(i, jjm+1, ilay) = pz(klon, ilay)
89  END DO
90  ! traitement des point normaux
91  DO j = 2, jjm
92  ig = 2 + (j-2)*iim
93  CALL scopy(iim, pz(ig,ilay), 1, zz(1,j,ilay), 1)
94  END DO
95  END DO
96  ! -----------------------------------------------------------------------
97  DO ilay = 1, llm
98  ig = 0
99  DO j = j_deb, j_fin
100  DO i = i1_deb, i1_fin
101  ig = ig + 1
102  zzz(ig) = zz(i, j, ilay)
103  END DO
104  DO i = i2_deb, i2_fin
105  ig = ig + 1
106  zzz(ig) = zz(i, j, ilay)
107  END DO
108  END DO
109 #ifdef VPP
110  CALL ecriture(unit, zzz, nleng)
111 #else
112  WRITE (unit) zzz
113 #endif
114  END DO
115 
116  RETURN
117 END SUBROUTINE ecrirega
ecriregs
subroutine ecriregs(unit, pz)
Definition: ecrireg.F90:5
ecrirega
subroutine ecrirega(unit, pz)
Definition: ecrireg.F90:60
i1_deb
!$Id!Valid and equivalent for either free source form or fixed source form INTEGER i1_deb
Definition: regdim.h:5
dimphy::klon
integer, save klon
Definition: dimphy.F90:3
llm
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
Definition: 1D_interp_cases.h:103
dimphy::klev
integer, save klev
Definition: dimphy.F90:7
scopy
subroutine scopy(n, sx, incx, sy, incy)
Definition: cray.F:9
parameter
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
i2_deb
!$Id!Valid and equivalent for either free source form or fixed source form INTEGER i1_fin INTEGER i2_deb
Definition: regdim.h:5
iim
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24
dimphy
Definition: dimphy.F90:1