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
RevLine 
[2299]1MODULE dynredem_mod
2
[5128]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
[5090]5  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
[5159]6  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
7  USE lmdz_paramet
[5069]8  IMPLICIT NONE; PRIVATE
[2299]9  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
[5060]10  PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg
[5159]11
12
[5128]13  CHARACTER(LEN = 256), SAVE :: fil, modname
14  INTEGER, SAVE :: nvarid
[2299]15
16
17CONTAINS
18
19
[5128]20  !===============================================================================
[5099]21
[5128]22  SUBROUTINE dynredem_write_u(ncid, id, var, ll)
[5099]23
[5128]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)
[5099]37
[5128]38  END SUBROUTINE dynredem_write_u
[2299]39
[5128]40  !===============================================================================
[2299]41
[5099]42
[5128]43  !===============================================================================
[5099]44
[5128]45  SUBROUTINE dynredem_write_v(ncid, id, var, ll)
[5099]46
[5128]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)
[2299]60
[5128]61  END SUBROUTINE dynredem_write_v
[2299]62
[5128]63  !===============================================================================
[5099]64
65
[5128]66  !===============================================================================
[5099]67
[5128]68  SUBROUTINE dynredem_read_u(ncid, id, var, ll)
[2299]69
[5128]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)
[2299]83
[5128]84  END SUBROUTINE dynredem_read_u
[5099]85
[5128]86  !===============================================================================
[5099]87
[2299]88
[5128]89  !===============================================================================
[5099]90
[5128]91  SUBROUTINE cre_var(ncid, var, title, did, units)
[2299]92
[5128]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)
[2299]103
[5128]104  END SUBROUTINE cre_var
[5099]105
[5128]106  !===============================================================================
[5099]107
[2299]108
[5128]109  !===============================================================================
[5099]110
[5128]111  SUBROUTINE put_var1(ncid, var, title, did, v, units)
[2299]112
[5128]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))
[2299]126
[5128]127  END SUBROUTINE put_var1
[5099]128
[5128]129  !===============================================================================
[5099]130
[2299]131
[5128]132  !===============================================================================
[5099]133
[5128]134  SUBROUTINE put_var2(ncid, var, title, did, v, units)
[2299]135
[5128]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))
[2299]149
[5128]150  END SUBROUTINE put_var2
[5099]151
[5128]152  !===============================================================================
[5099]153
[2299]154
[5128]155  !===============================================================================
[5099]156
[5128]157  FUNCTION msg(typ, nam)
[2299]158
[5128]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) // ">"
[2299]174
[5128]175  END FUNCTION msg
[5099]176
[5128]177  !===============================================================================
[5099]178
[2299]179
[5128]180  !===============================================================================
[5099]181
[5128]182  SUBROUTINE err(ierr, typ, nam)
[2299]183
[5128]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
[2299]201END MODULE dynredem_mod   
202   
203   
Note: See TracBrowser for help on using the repository browser.