Directory: | ./ |
---|---|
File: | dyn/dynredem_mod.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 31 | 49 | 63.3% |
Branches: | 16 | 53 | 30.2% |
Line | Branch | Exec | Source |
---|---|---|---|
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 |
2/2✓ Branch 0 taken 36 times.
✓ Branch 1 taken 9 times.
|
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 |
2/2✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
|
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 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 25 times.
|
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 | 25 | CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var) | |
105 |
2/2✓ Branch 0 taken 24 times.
✓ Branch 1 taken 1 times.
|
25 | IF(title/="") CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var) |
106 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 24 times.
|
25 | IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var) |
107 | |||
108 | 25 | END SUBROUTINE cre_var | |
109 | ! | ||
110 | !=============================================================================== | ||
111 | |||
112 | |||
113 | !=============================================================================== | ||
114 | ! | ||
115 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 10 times.
|
10 | SUBROUTINE put_var1(ncid,var,title,did,v,units) |
116 | ! | ||
117 | !=============================================================================== | ||
118 | IMPLICIT NONE | ||
119 | !=============================================================================== | ||
120 | ! Arguments: | ||
121 | INTEGER, INTENT(IN) :: ncid | ||
122 | CHARACTER(LEN=*), INTENT(IN) :: var, title | ||
123 | INTEGER, INTENT(IN) :: did(1) | ||
124 | REAL, INTENT(IN) :: v(:) | ||
125 | CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units | ||
126 | !=============================================================================== | ||
127 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 10 times.
|
10 | IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) |
128 |
1/2✓ Branch 0 taken 10 times.
✗ Branch 1 not taken.
|
10 | IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) |
129 | 10 | CALL err(NF90_ENDDEF(ncid)) | |
130 | 10 | CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var) | |
131 | 10 | CALL err(NF90_REDEF(ncid)) | |
132 | |||
133 | 10 | END SUBROUTINE put_var1 | |
134 | ! | ||
135 | !=============================================================================== | ||
136 | |||
137 | |||
138 | !=============================================================================== | ||
139 | ! | ||
140 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4 times.
|
4 | SUBROUTINE put_var2(ncid,var,title,did,v,units) |
141 | ! | ||
142 | !=============================================================================== | ||
143 | IMPLICIT NONE | ||
144 | !=============================================================================== | ||
145 | ! Arguments: | ||
146 | INTEGER, INTENT(IN) :: ncid | ||
147 | CHARACTER(LEN=*), INTENT(IN) :: var, title | ||
148 | INTEGER, INTENT(IN) :: did(2) | ||
149 | REAL, INTENT(IN) :: v(:,:) | ||
150 | CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units | ||
151 | !=============================================================================== | ||
152 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4 times.
|
4 | IF( PRESENT(units)) CALL cre_var(ncid,var,title,did,units) |
153 |
1/2✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
|
4 | IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did) |
154 | 4 | CALL err(NF90_ENDDEF(ncid)) | |
155 | 4 | CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var) | |
156 | 4 | CALL err(NF90_REDEF(ncid)) | |
157 | |||
158 | 4 | END SUBROUTINE put_var2 | |
159 | ! | ||
160 | !=============================================================================== | ||
161 | |||
162 | |||
163 | !=============================================================================== | ||
164 | ! | ||
165 | ✗ | FUNCTION msg(typ,nam) | |
166 | ! | ||
167 | !=============================================================================== | ||
168 | IMPLICIT NONE | ||
169 | !=============================================================================== | ||
170 | ! Arguments: | ||
171 | CHARACTER(LEN=256) :: msg !--- STANDARDIZED MESSAGE | ||
172 | CHARACTER(LEN=*), INTENT(IN) :: typ !--- TYPE OF OPERATION | ||
173 | CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME | ||
174 | !=============================================================================== | ||
175 | ✗ | SELECT CASE(typ) | |
176 | ✗ | CASE('open'); msg="Opening failed for <"//TRIM(fil)//">" | |
177 | ✗ | CASE('close'); msg="Closing failed for <"//TRIM(fil)//">" | |
178 | ✗ | CASE('get'); msg="Reading failed for <"//TRIM(nam)//">" | |
179 | ✗ | CASE('put'); msg="Writting failed for <"//TRIM(nam)//">" | |
180 | ✗ | CASE('inq'); msg="Missing field <"//TRIM(nam)//">" | |
181 | ✗ | CASE('fnd'); msg="Found field <"//TRIM(nam)//">" | |
182 | END SELECT | ||
183 | ✗ | msg=TRIM(msg)//" in file <"//TRIM(fil)//">" | |
184 | |||
185 | ✗ | END FUNCTION msg | |
186 | ! | ||
187 | !=============================================================================== | ||
188 | |||
189 | |||
190 | !=============================================================================== | ||
191 | ! | ||
192 | 131 | SUBROUTINE err(ierr,typ,nam) | |
193 | ! | ||
194 | !=============================================================================== | ||
195 | IMPLICIT NONE | ||
196 | !=============================================================================== | ||
197 | ! Arguments: | ||
198 | INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE | ||
199 | CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ !--- TYPE OF OPERATION | ||
200 | CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam !--- FIELD NAME | ||
201 | !=============================================================================== | ||
202 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 131 times.
|
131 | IF(ierr==NF90_NoERR) RETURN |
203 | ✗ | IF(.NOT.PRESENT(typ)) THEN | |
204 | ✗ | CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr) | |
205 | ELSE | ||
206 | ✗ | CALL ABORT_gcm(modname,msg(typ,nam),ierr) | |
207 | END IF | ||
208 | |||
209 | END SUBROUTINE err | ||
210 | ! | ||
211 | !=============================================================================== | ||
212 | |||
213 | END MODULE dynredem_mod | ||
214 | |||
215 | |||
216 |