- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/TOOLS/SIREN/src/attribute.f90
r5617 r7351 83 83 !> @date November, 2014 84 84 !> - Fix memory leaks bug 85 !> @date September, 2015 86 !> - manage useless (dummy) attributes 85 87 ! 86 88 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 98 100 PUBLIC :: TATT !< attribute structure 99 101 102 PRIVATE :: cm_dumatt !< dummy attribute array 103 100 104 ! function and subroutine 101 105 PUBLIC :: att_init !< initialize attribute structure … … 105 109 PUBLIC :: att_get_index !< get attribute index, in an array of attribute structure 106 110 PUBLIC :: att_get_id !< get attribute id, read from file 111 PUBLIC :: att_get_dummy !< fill dummy attribute array 112 PUBLIC :: att_is_dummy !< check if attribute is defined as dummy attribute 107 113 108 114 PRIVATE :: att__clean_unit ! clean attribute strcuture … … 135 141 END TYPE TATT 136 142 143 CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumatt !< dummy attribute 144 137 145 INTERFACE att_init 138 146 MODULE PROCEDURE att__init_c … … 1251 1259 1252 1260 END SUBROUTINE att__clean_arr 1261 !------------------------------------------------------------------- 1262 !> @brief This subroutine fill dummy attribute array 1263 ! 1264 !> @author J.Paul 1265 !> @date September, 2015 - Initial Version 1266 !> @date Marsh, 2016 1267 !> - close file (bugfix) 1268 ! 1269 !> @param[in] cd_dummy dummy configuration file 1270 !------------------------------------------------------------------- 1271 SUBROUTINE att_get_dummy( cd_dummy ) 1272 IMPLICIT NONE 1273 ! Argument 1274 CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 1275 1276 ! local variable 1277 INTEGER(i4) :: il_fileid 1278 INTEGER(i4) :: il_status 1279 1280 LOGICAL :: ll_exist 1281 1282 ! loop indices 1283 ! namelist 1284 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 1285 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 1286 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 1287 1288 !---------------------------------------------------------------- 1289 NAMELIST /namdum/ & !< dummy namelist 1290 & cn_dumvar, & !< variable name 1291 & cn_dumdim, & !< dimension name 1292 & cn_dumatt !< attribute name 1293 !---------------------------------------------------------------- 1294 1295 ! init 1296 cm_dumatt(:)='' 1297 1298 ! read namelist 1299 INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 1300 IF( ll_exist )THEN 1301 1302 il_fileid=fct_getunit() 1303 1304 OPEN( il_fileid, FILE=TRIM(cd_dummy), & 1305 & FORM='FORMATTED', & 1306 & ACCESS='SEQUENTIAL', & 1307 & STATUS='OLD', & 1308 & ACTION='READ', & 1309 & IOSTAT=il_status) 1310 CALL fct_err(il_status) 1311 IF( il_status /= 0 )THEN 1312 CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 1313 ENDIF 1314 1315 READ( il_fileid, NML = namdum ) 1316 cm_dumatt(:)=cn_dumatt(:) 1317 1318 CLOSE( il_fileid ) 1319 1320 ENDIF 1321 1322 END SUBROUTINE att_get_dummy 1323 !------------------------------------------------------------------- 1324 !> @brief This function check if attribute is defined as dummy attribute 1325 !> in configuraton file 1326 !> 1327 !> @author J.Paul 1328 !> @date September, 2015 - Initial Version 1329 ! 1330 !> @param[in] td_att attribute structure 1331 !> @return true if attribute is dummy attribute 1332 !------------------------------------------------------------------- 1333 FUNCTION att_is_dummy(td_att) 1334 IMPLICIT NONE 1335 1336 ! Argument 1337 TYPE(TATT), INTENT(IN) :: td_att 1338 1339 ! function 1340 LOGICAL :: att_is_dummy 1341 1342 ! loop indices 1343 INTEGER(i4) :: ji 1344 !---------------------------------------------------------------- 1345 1346 att_is_dummy=.FALSE. 1347 DO ji=1,ip_maxdum 1348 IF( fct_lower(td_att%c_name) == fct_lower(cm_dumatt(ji)) )THEN 1349 att_is_dummy=.TRUE. 1350 EXIT 1351 ENDIF 1352 ENDDO 1353 1354 END FUNCTION att_is_dummy 1253 1355 END MODULE att 1254 1356
Note: See TracChangeset
for help on using the changeset viewer.