source: LMDZ5/branches/testing/libf/phylmd/ecribin.F90 @ 1999

Last change on this file since 1999 was 1999, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes r1920:1997 into testing branch

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