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

Last change on this file was 5159, checked in by abarral, 7 weeks ago

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