source: LMDZ6/branches/LMDZ_cdrag_LSCE/libf/obsolete/ecribin.F90 @ 4660

Last change on this file since 4660 was 2321, checked in by Ehouarn Millour, 10 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.