source: LMDZ5/trunk/libf/obsolete/ecrireg.F90 @ 4848

Last change on this file since 4848 was 2321, checked in by Ehouarn Millour, 9 years ago

Create the "obsolete" directory where old and unused stuff should go. And move some obsolete routines there.
Minor correction in "print_control_mod": use "opened" argument to inquire instead of "exist".
EM
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.6 KB
RevLine 
[1992]1
[524]2! $Header$
[1992]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 "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
[524]52#ifdef VPP
[1992]53  CALL ecriture(unit, zzz, nleng)
[524]54#else
[1992]55  WRITE (unit) zzz
[524]56#endif
[1992]57  RETURN
58END SUBROUTINE ecriregs
59SUBROUTINE 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
[524]109#ifdef VPP
[1992]110    CALL ecriture(unit, zzz, nleng)
[524]111#else
[1992]112    WRITE (unit) zzz
[524]113#endif
[1992]114  END DO
[524]115
[1992]116  RETURN
117END SUBROUTINE ecrirega
Note: See TracBrowser for help on using the repository browser.