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
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
[5069]6  IMPLICIT NONE; PRIVATE
[2299]7  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
[5060]8  PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg
[5134]9  INCLUDE "dimensions.h"
10  INCLUDE "paramet.h"
[5128]11  CHARACTER(LEN = 256), SAVE :: fil, modname
12  INTEGER, SAVE :: nvarid
[2299]13
14
15CONTAINS
16
17
[5128]18  !===============================================================================
[5099]19
[5128]20  SUBROUTINE dynredem_write_u(ncid, id, var, ll)
[5099]21
[5128]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)
[5099]35
[5128]36  END SUBROUTINE dynredem_write_u
[2299]37
[5128]38  !===============================================================================
[2299]39
[5099]40
[5128]41  !===============================================================================
[5099]42
[5128]43  SUBROUTINE dynredem_write_v(ncid, id, var, ll)
[5099]44
[5128]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)
[2299]58
[5128]59  END SUBROUTINE dynredem_write_v
[2299]60
[5128]61  !===============================================================================
[5099]62
63
[5128]64  !===============================================================================
[5099]65
[5128]66  SUBROUTINE dynredem_read_u(ncid, id, var, ll)
[2299]67
[5128]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)
[2299]81
[5128]82  END SUBROUTINE dynredem_read_u
[5099]83
[5128]84  !===============================================================================
[5099]85
[2299]86
[5128]87  !===============================================================================
[5099]88
[5128]89  SUBROUTINE cre_var(ncid, var, title, did, units)
[2299]90
[5128]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)
[2299]101
[5128]102  END SUBROUTINE cre_var
[5099]103
[5128]104  !===============================================================================
[5099]105
[2299]106
[5128]107  !===============================================================================
[5099]108
[5128]109  SUBROUTINE put_var1(ncid, var, title, did, v, units)
[2299]110
[5128]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))
[2299]124
[5128]125  END SUBROUTINE put_var1
[5099]126
[5128]127  !===============================================================================
[5099]128
[2299]129
[5128]130  !===============================================================================
[5099]131
[5128]132  SUBROUTINE put_var2(ncid, var, title, did, v, units)
[2299]133
[5128]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))
[2299]147
[5128]148  END SUBROUTINE put_var2
[5099]149
[5128]150  !===============================================================================
[5099]151
[2299]152
[5128]153  !===============================================================================
[5099]154
[5128]155  FUNCTION msg(typ, nam)
[2299]156
[5128]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) // ">"
[2299]172
[5128]173  END FUNCTION msg
[5099]174
[5128]175  !===============================================================================
[5099]176
[2299]177
[5128]178  !===============================================================================
[5099]179
[5128]180  SUBROUTINE err(ierr, typ, nam)
[2299]181
[5128]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
[2299]199END MODULE dynredem_mod   
200   
201   
Note: See TracBrowser for help on using the repository browser.