1 |
|
|
MODULE dynredem_mod |
2 |
|
|
|
3 |
|
|
USE netcdf |
4 |
|
|
PRIVATE |
5 |
|
|
PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err |
6 |
|
|
PUBLIC :: cre_var, get_var1, put_var1, put_var2, fil, modname, msg |
7 |
|
|
include "dimensions.h" |
8 |
|
|
include "paramet.h" |
9 |
|
|
CHARACTER(LEN=256), SAVE :: fil, modname |
10 |
|
|
INTEGER, SAVE :: nvarid |
11 |
|
|
|
12 |
|
|
|
13 |
|
|
CONTAINS |
14 |
|
|
|
15 |
|
|
|
16 |
|
|
!=============================================================================== |
17 |
|
|
! |
18 |
|
9 |
SUBROUTINE dynredem_write_u(ncid,id,var,ll) |
19 |
|
|
! |
20 |
|
|
!=============================================================================== |
21 |
|
|
IMPLICIT NONE |
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 |
✓✓ |
45 |
start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1] |
33 |
|
9 |
CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) |
34 |
|
9 |
CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id) |
35 |
|
|
|
36 |
|
9 |
END SUBROUTINE dynredem_write_u |
37 |
|
|
! |
38 |
|
|
!=============================================================================== |
39 |
|
|
|
40 |
|
|
|
41 |
|
|
!=============================================================================== |
42 |
|
|
! |
43 |
|
1 |
SUBROUTINE dynredem_write_v(ncid,id,var,ll) |
44 |
|
|
! |
45 |
|
|
!=============================================================================== |
46 |
|
|
IMPLICIT NONE |
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 |
✓✓ |
5 |
start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,1] |
58 |
|
1 |
CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) |
59 |
|
1 |
CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id) |
60 |
|
|
|
61 |
|
1 |
END SUBROUTINE dynredem_write_v |
62 |
|
|
! |
63 |
|
|
!=============================================================================== |
64 |
|
|
|
65 |
|
|
|
66 |
|
|
!=============================================================================== |
67 |
|
|
! |
68 |
|
|
SUBROUTINE dynredem_read_u(ncid,id,var,ll) |
69 |
|
|
! |
70 |
|
|
!=============================================================================== |
71 |
|
|
IMPLICIT NONE |
72 |
|
|
!=============================================================================== |
73 |
|
|
! Arguments: |
74 |
|
|
INTEGER, INTENT(IN) :: ncid |
75 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: id |
76 |
|
|
REAL, INTENT(OUT) :: var(iip1,jjp1,ll) |
77 |
|
|
INTEGER, INTENT(IN) :: ll |
78 |
|
|
!=============================================================================== |
79 |
|
|
! Local variables: |
80 |
|
|
INTEGER :: start(4), count(4) |
81 |
|
|
!=============================================================================== |
82 |
|
|
start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1] |
83 |
|
|
CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id) |
84 |
|
|
CALL err(NF90_GET_VAR(ncid,nvarid,var,start,count),"get",id) |
85 |
|
|
|
86 |
|
|
END SUBROUTINE dynredem_read_u |
87 |
|
|
! |
88 |
|
|
!=============================================================================== |
89 |
|
|
|
90 |
|
|
|
91 |
|
|
!=============================================================================== |
92 |
|
|
! |
93 |
✗✓ |
25 |
SUBROUTINE cre_var(ncid,var,title,did,units) |
94 |
|
|
! |
95 |
|
|
!=============================================================================== |
96 |
|
|
IMPLICIT NONE |
97 |
|
|
!=============================================================================== |
98 |
|
|
! Arguments: |
99 |
|
|
INTEGER, INTENT(IN) :: ncid |
100 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: var, title |
101 |
|
|
INTEGER, INTENT(IN) :: did(:) |
102 |
|
|
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units |
103 |
|
|
!=============================================================================== |
104 |
|
|
#ifdef NC_DOUBLE |
105 |
|
25 |
CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var) |
106 |
|
|
#else |
107 |
|
|
CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var) |
108 |
|
|
#endif |
109 |
✓✓ |
25 |
IF(title/="") CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var) |
110 |
✓✓ |
25 |
IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var) |
111 |
|
|
|
112 |
|
25 |
END SUBROUTINE cre_var |
113 |
|
|
! |
114 |
|
|
!=============================================================================== |
115 |
|
|
|
116 |
|
|
|
117 |
|
|
!=============================================================================== |
118 |
|
|
! |
119 |
✗✓ |
10 |
SUBROUTINE put_var1(ncid,var,title,did,v,units) |
120 |
|
|
! |
121 |
|
|
!=============================================================================== |
122 |
|
|
IMPLICIT NONE |
123 |
|
|
!=============================================================================== |
124 |
|
|
! Arguments: |
125 |
|
|
INTEGER, INTENT(IN) :: ncid |
126 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: var, title |
127 |
|
|
INTEGER, INTENT(IN) :: did(1) |
128 |
|
|
REAL, INTENT(IN) :: v(:) |
129 |
|
|
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units |
130 |
|
|
!=============================================================================== |
131 |
✗✓ |
10 |
IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) |
132 |
✓✗ |
10 |
IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) |
133 |
|
10 |
CALL err(NF90_ENDDEF(ncid)) |
134 |
|
10 |
CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var) |
135 |
|
10 |
CALL err(NF90_REDEF(ncid)) |
136 |
|
|
|
137 |
|
10 |
END SUBROUTINE put_var1 |
138 |
|
|
! |
139 |
|
|
!=============================================================================== |
140 |
|
|
|
141 |
|
|
|
142 |
|
|
!=============================================================================== |
143 |
|
|
! |
144 |
✗✓ |
4 |
SUBROUTINE put_var2(ncid,var,title,did,v,units) |
145 |
|
|
! |
146 |
|
|
!=============================================================================== |
147 |
|
|
IMPLICIT NONE |
148 |
|
|
!=============================================================================== |
149 |
|
|
! Arguments: |
150 |
|
|
INTEGER, INTENT(IN) :: ncid |
151 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: var, title |
152 |
|
|
INTEGER, INTENT(IN) :: did(2) |
153 |
|
|
REAL, INTENT(IN) :: v(:,:) |
154 |
|
|
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units |
155 |
|
|
!=============================================================================== |
156 |
✗✓ |
4 |
IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) |
157 |
✓✗ |
4 |
IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) |
158 |
|
4 |
CALL err(NF90_ENDDEF(ncid)) |
159 |
|
4 |
CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var) |
160 |
|
4 |
CALL err(NF90_REDEF(ncid)) |
161 |
|
|
|
162 |
|
4 |
END SUBROUTINE put_var2 |
163 |
|
|
! |
164 |
|
|
!=============================================================================== |
165 |
|
|
|
166 |
|
|
|
167 |
|
|
!=============================================================================== |
168 |
|
|
! |
169 |
|
|
FUNCTION msg(typ,nam) |
170 |
|
|
! |
171 |
|
|
!=============================================================================== |
172 |
|
|
IMPLICIT NONE |
173 |
|
|
!=============================================================================== |
174 |
|
|
! Arguments: |
175 |
|
|
CHARACTER(LEN=256) :: msg !--- STANDARDIZED MESSAGE |
176 |
|
|
CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION |
177 |
|
|
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME |
178 |
|
|
!=============================================================================== |
179 |
|
|
SELECT CASE(typ) |
180 |
|
|
CASE('open'); msg="Opening failed for <"//TRIM(fil)//">" |
181 |
|
|
CASE('close'); msg="Closing failed for <"//TRIM(fil)//">" |
182 |
|
|
CASE('get'); msg="Reading failed for <"//TRIM(nam)//">" |
183 |
|
|
CASE('put'); msg="Writting failed for <"//TRIM(nam)//">" |
184 |
|
|
CASE('inq'); msg="Missing field <"//TRIM(nam)//">" |
185 |
|
|
CASE('fnd'); msg="Found field <"//TRIM(nam)//">" |
186 |
|
|
END SELECT |
187 |
|
|
msg=TRIM(msg)//" in file <"//TRIM(fil)//">" |
188 |
|
|
|
189 |
|
|
END FUNCTION msg |
190 |
|
|
! |
191 |
|
|
!=============================================================================== |
192 |
|
|
|
193 |
|
|
|
194 |
|
|
!=============================================================================== |
195 |
|
|
! |
196 |
|
131 |
SUBROUTINE err(ierr,typ,nam) |
197 |
|
|
! |
198 |
|
|
!=============================================================================== |
199 |
|
|
IMPLICIT NONE |
200 |
|
|
!=============================================================================== |
201 |
|
|
! Arguments: |
202 |
|
|
INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE |
203 |
|
|
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ !--- TYPE OF OPERATION |
204 |
|
|
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME |
205 |
|
|
!=============================================================================== |
206 |
✗✓ |
131 |
IF(ierr==NF90_NoERR) RETURN |
207 |
|
|
IF(.NOT.PRESENT(typ)) THEN |
208 |
|
|
CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr) |
209 |
|
|
ELSE |
210 |
|
|
CALL ABORT_gcm(modname,msg(typ,nam),ierr) |
211 |
|
|
END IF |
212 |
|
|
|
213 |
|
|
END SUBROUTINE err |
214 |
|
|
! |
215 |
|
|
!=============================================================================== |
216 |
|
|
|
217 |
|
|
END MODULE dynredem_mod |
218 |
|
|
|
219 |
|
|
|