source: LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem_mod.F90 @ 5134

Last change on this file since 5134 was 5134, checked in by abarral, 8 weeks ago

Replace academic.h, alpale.h, comdissip.h, comdissipn.h, comdissnew.h by modules
Remove unused clesph0.h
File size: 7.6 KB
Line 
1MODULE dynredem_mod
2
3  USE netcdf, ONLY: nf90_strerror, nf90_noerr, nf90_redef, nf90_put_var, nf90_enddef, nf90_put_att, &
4          nf90_inq_varid, nf90_get_var, nf90_def_var
5  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
6  IMPLICIT NONE; PRIVATE
7  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
8  PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg
9  INCLUDE "dimensions.h"
10  INCLUDE "paramet.h"
11  CHARACTER(LEN = 256), SAVE :: fil, modname
12  INTEGER, SAVE :: nvarid
13
14
15CONTAINS
16
17
18  !===============================================================================
19
20  SUBROUTINE dynredem_write_u(ncid, id, var, ll)
21
22    !===============================================================================
23    ! Arguments:
24    INTEGER, INTENT(IN) :: ncid
25    CHARACTER(LEN = *), INTENT(IN) :: id
26    REAL, INTENT(IN) :: var(iip1, jjp1, ll)
27    INTEGER, INTENT(IN) :: ll
28    !===============================================================================
29    ! Local variables:
30    INTEGER :: start(4), count(4)
31    !===============================================================================
32    start(:) = [1, 1, 1, 1]; count(:) = [iip1, jjp1, ll, 1]
33    CALL err(nf90_inq_varid(ncid, id, nvarid), "inq", id)
34    CALL err(nf90_put_var(ncid, nvarid, var, start, count), "put", id)
35
36  END SUBROUTINE dynredem_write_u
37
38  !===============================================================================
39
40
41  !===============================================================================
42
43  SUBROUTINE dynredem_write_v(ncid, id, var, ll)
44
45    !===============================================================================
46    ! Arguments:
47    INTEGER, INTENT(IN) :: ncid
48    CHARACTER(LEN = *), INTENT(IN) :: id
49    REAL, INTENT(IN) :: var(iip1, jjm, ll)
50    INTEGER, INTENT(IN) :: ll
51    !===============================================================================
52    ! Local variables:
53    INTEGER :: start(4), count(4)
54    !===============================================================================
55    start(:) = [1, 1, 1, 1]; count(:) = [iip1, jjm, ll, 1]
56    CALL err(nf90_inq_varid(ncid, id, nvarid), "inq", id)
57    CALL err(nf90_put_var(ncid, nvarid, var, start, count), "put", id)
58
59  END SUBROUTINE dynredem_write_v
60
61  !===============================================================================
62
63
64  !===============================================================================
65
66  SUBROUTINE dynredem_read_u(ncid, id, var, ll)
67
68    !===============================================================================
69    ! Arguments:
70    INTEGER, INTENT(IN) :: ncid
71    CHARACTER(LEN = *), INTENT(IN) :: id
72    REAL, INTENT(OUT) :: var(iip1, jjp1, ll)
73    INTEGER, INTENT(IN) :: ll
74    !===============================================================================
75    ! Local variables:
76    INTEGER :: start(4), count(4)
77    !===============================================================================
78    start(:) = [1, 1, 1, 1]; count(:) = [iip1, jjp1, ll, 1]
79    CALL err(nf90_inq_varid(ncid, id, nvarid), "inq", id)
80    CALL err(nf90_get_var(ncid, nvarid, var, start, count), "get", id)
81
82  END SUBROUTINE dynredem_read_u
83
84  !===============================================================================
85
86
87  !===============================================================================
88
89  SUBROUTINE cre_var(ncid, var, title, did, units)
90
91    !===============================================================================
92    ! Arguments:
93    INTEGER, INTENT(IN) :: ncid
94    CHARACTER(LEN = *), INTENT(IN) :: var, title
95    INTEGER, INTENT(IN) :: did(:)
96    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: units
97    !===============================================================================
98    CALL err(nf90_def_var(ncid, var, nf90_format, did, nvarid), "inq", var)
99    IF(title/="")      CALL err(nf90_put_att(ncid, nvarid, "title", title), var)
100    IF(PRESENT(units)) CALL err(nf90_put_att(ncid, nvarid, "units", units), var)
101
102  END SUBROUTINE cre_var
103
104  !===============================================================================
105
106
107  !===============================================================================
108
109  SUBROUTINE put_var1(ncid, var, title, did, v, units)
110
111    !===============================================================================
112    ! Arguments:
113    INTEGER, INTENT(IN) :: ncid
114    CHARACTER(LEN = *), INTENT(IN) :: var, title
115    INTEGER, INTENT(IN) :: did(1)
116    REAL, INTENT(IN) :: v(:)
117    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: units
118    !===============================================================================
119    IF(PRESENT(units)) CALL cre_var(ncid, var, title, did, units)
120    IF(.NOT.PRESENT(units)) CALL cre_var(ncid, var, title, did)
121    CALL err(nf90_enddef(ncid))
122    CALL err(nf90_put_var(ncid, nvarid, v), "put", var)
123    CALL err(nf90_redef(ncid))
124
125  END SUBROUTINE put_var1
126
127  !===============================================================================
128
129
130  !===============================================================================
131
132  SUBROUTINE put_var2(ncid, var, title, did, v, units)
133
134    !===============================================================================
135    ! Arguments:
136    INTEGER, INTENT(IN) :: ncid
137    CHARACTER(LEN = *), INTENT(IN) :: var, title
138    INTEGER, INTENT(IN) :: did(2)
139    REAL, INTENT(IN) :: v(:, :)
140    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: units
141    !===============================================================================
142    IF(PRESENT(units)) CALL cre_var(ncid, var, title, did, units)
143    IF(.NOT.PRESENT(units)) CALL cre_var(ncid, var, title, did)
144    CALL err(nf90_enddef(ncid))
145    CALL err(nf90_put_var(ncid, nvarid, v), "put", var)
146    CALL err(nf90_redef(ncid))
147
148  END SUBROUTINE put_var2
149
150  !===============================================================================
151
152
153  !===============================================================================
154
155  FUNCTION msg(typ, nam)
156
157    !===============================================================================
158    ! Arguments:
159    CHARACTER(LEN = 256) :: msg    !--- STANDARDIZED MESSAGE
160    CHARACTER(LEN = *), INTENT(IN) :: typ    !--- TYPE OF OPERATION
161    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
162    !===============================================================================
163    SELECT CASE(typ)
164    CASE('open');  msg = "Opening failed for <" // TRIM(fil) // ">"
165    CASE('close'); msg = "Closing failed for <" // TRIM(fil) // ">"
166    CASE('get');   msg = "Reading failed for <" // TRIM(nam) // ">"
167    CASE('put');   msg = "Writting failed for <" // TRIM(nam) // ">"
168    CASE('inq');   msg = "Missing field <" // TRIM(nam) // ">"
169    CASE('fnd');   msg = "Found field <" // TRIM(nam) // ">"
170    END SELECT
171    msg = TRIM(msg) // " in file <" // TRIM(fil) // ">"
172
173  END FUNCTION msg
174
175  !===============================================================================
176
177
178  !===============================================================================
179
180  SUBROUTINE err(ierr, typ, nam)
181
182    !===============================================================================
183    ! Arguments:
184    INTEGER, INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
185    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
186    CHARACTER(LEN = *), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
187    !===============================================================================
188    IF(ierr==nf90_noerr) RETURN
189    IF(.NOT.PRESENT(typ)) THEN
190      CALL ABORT_gcm(modname, nf90_strerror(ierr), ierr)
191    ELSE
192      CALL ABORT_gcm(modname, msg(typ, nam), ierr)
193    END IF
194
195  END SUBROUTINE err
196
197  !===============================================================================
198
199END MODULE dynredem_mod   
200   
201   
Note: See TracBrowser for help on using the repository browser.