source: LMDZ5/trunk/libf/obsolete/ecribin.F90 @ 5084

Last change on this file since 5084 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.3 KB
Line 
1
2! $Header$
3
4SUBROUTINE ecribins(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
13  ! arguments:
14  ! ----------
15  INTEGER unit
16  REAL pz(klon)
17
18  ! local:
19  ! ------
20  INTEGER i, j, ig
21  REAL zz(iim+1, jjm+1)
22  ! -----------------------------------------------------------------------
23  ! passage a la grille dynamique:
24  ! ------------------------------
25  DO i = 1, iim + 1
26    zz(i, 1) = pz(1)
27    zz(i, jjm+1) = pz(klon)
28  END DO
29  ! traitement des point normaux
30  DO j = 2, jjm
31    ig = 2 + (j-2)*iim
32    CALL scopy(iim, pz(ig), 1, zz(1,j), 1)
33    zz(iim+1, j) = zz(1, j)
34  END DO
35  ! -----------------------------------------------------------------------
36#ifdef VPP
37  CALL ecriture(unit, zz, (iim+1)*(jjm+1))
38#else
39  WRITE (unit) zz
40#endif
41
42
43  RETURN
44END SUBROUTINE ecribins
45SUBROUTINE ecribina(unit, pz)
46  USE dimphy
47  IMPLICIT NONE
48  ! -----------------------------------------------------------------------
49  include "dimensions.h"
50  ! ccc#include "dimphy.h"
51  include "paramet.h"
52  include "comgeom.h"
53
54  ! arguments:
55  ! ----------
56  INTEGER unit
57  REAL pz(klon, klev)
58
59  ! local:
60  ! ------
61  INTEGER i, j, ilay, ig
62  REAL zz(iim+1, jjm+1, llm)
63  ! -----------------------------------------------------------------------
64  ! passage a la grille dynamique:
65  ! ------------------------------
66  DO ilay = 1, llm
67    ! traitement des poles
68    DO i = 1, iim + 1
69      zz(i, 1, ilay) = pz(1, ilay)
70      zz(i, jjm+1, ilay) = pz(klon, ilay)
71    END DO
72    ! traitement des point normaux
73    DO j = 2, jjm
74      ig = 2 + (j-2)*iim
75      CALL scopy(iim, pz(ig,ilay), 1, zz(1,j,ilay), 1)
76      zz(iim+1, j, ilay) = zz(1, j, ilay)
77    END DO
78  END DO
79  ! -----------------------------------------------------------------------
80  DO ilay = 1, llm
81#ifdef VPP
82    CALL ecriture(unit, zz(1,1,ilay), (iim+1)*(jjm+1))
83#else
84    WRITE (unit)((zz(i,j,ilay),i=1,iim+1), j=1, jjm+1)
85#endif
86  END DO
87
88  RETURN
89END SUBROUTINE ecribina
90#ifdef VPP
91@OPTIONS NODOUBLE
92SUBROUTINE ecriture(nunit, r8, n)
93  INTEGER nunit, n, i
94  REAL (KIND=8) r8(n)
95  REAL r4(n)
96
97  DO i = 1, n
98    r4(i) = r8(i)
99  END DO
100  WRITE (nunit) r4
101  RETURN
102END SUBROUTINE ecriture
103#endif
Note: See TracBrowser for help on using the repository browser.