LMDZ
ecrireg.F90
Go to the documentation of this file.
1 
2 ! $Id$
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 "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
59 END SUBROUTINE ecriregs
60 SUBROUTINE 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
119 END SUBROUTINE ecrirega
subroutine ecriregs(unit, pz)
Definition: ecrireg.F90:5
subroutine ecrirega(unit, pz)
Definition: ecrireg.F90:60
!$Id!Valid and equivalent for either free source form or fixed source form INTEGER i1_deb
Definition: regdim.h:5
integer, save klon
Definition: dimphy.F90:3
!$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
integer, save klev
Definition: dimphy.F90:7
subroutine scopy(n, sx, incx, sy, incy)
Definition: cray.F:9
!$Header!integer nvarmx parameter(nfmx=10, imx=200, jmx=150, lmx=200, nvarmx=1000) real xd(imx
!$Id!Valid and equivalent for either free source form or fixed source form INTEGER i1_fin INTEGER i2_deb
Definition: regdim.h:5
c c zjulian c cym CALL iim cym klev iim
Definition: ini_bilKP_ave.h:24
Definition: dimphy.F90:1