- Timestamp:
- 2016-11-30T14:21:17+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_MERCATOR_2016/NEMOGCM/TOOLS/SIREN/src/variable.f90
r6393 r7390 34 34 !> Note:<br/> 35 35 !> - others optionals arguments could be added, see var_init. 36 !> - to put variable 0D, use td_dim with all dimension unused36 !> - to put scalar variable (OD), use td_dim with all dimension unused 37 37 !> (td_dim(:)%l_use=.FALSE.) 38 38 !> … … 267 267 !> - cd_varinfo is variable information from namelist 268 268 !> 269 !> to clean global array of variable structure:<br/> 270 !>@code 271 !> CALL var_clean_extra( ) 272 !>@endcode 273 !> 269 274 !> to check variable dimension expected, as defined in file 'variable.cfg':<br/> 270 275 !>@code … … 287 292 !> @date Spetember, 2015 288 293 !> - manage useless (dummy) variable 289 ! 294 !> @date October, 2016 295 !> - add subroutine to clean global array of extra information. 296 !> - define logical for variable to be used 297 !> 290 298 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 291 299 !---------------------------------------------------------------------- … … 337 345 PUBLIC :: var_def_extra !< read variable configuration file, and save extra information. 338 346 PUBLIC :: var_chg_extra !< read variable namelist information, and modify extra information. 347 PUBLIC :: var_clean_extra !< clean gloabl array of extra information. 339 348 PUBLIC :: var_check_dim !< check variable dimension expected 340 349 PUBLIC :: var_get_dummy !< fill dummy variable array … … 416 425 TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< variable dimension 417 426 418 LOGICAL :: l_file = .FALSE. !< variable read in a file 427 LOGICAL :: l_file = .FALSE. !< variable read in a file 428 LOGICAL :: l_use = .TRUE. !< variable to be used 419 429 420 430 ! highlight some attributes … … 451 461 !< fill when running var_def_extra() 452 462 453 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ), SAVE :: cm_dumvar !< dummy variable463 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumvar !< dummy variable 454 464 455 465 INTERFACE var_init … … 593 603 CALL att_clean(tl_att) 594 604 ENDIF 605 606 var__copy_unit%l_file = td_var%l_file 607 var__copy_unit%l_use = td_var%l_use 595 608 596 609 ! copy highlight attribute … … 1126 1139 !> @date July, 2015 1127 1140 !> - add unit factor (to change unit) 1141 !> @date November, 2016 1142 !> - allow to add scalar value 1128 1143 !> 1129 1144 !> @param[in] cd_name variable name … … 1279 1294 dl_value(1,1,1,:) = dd_value(:) 1280 1295 ELSE 1281 CALL logger_fatal("VAR INIT: can not add value from variable "//& 1282 & TRIM(cd_name)//". invalid dimension to be used") 1296 IF( SIZE(dd_value(:)) > 1 )THEN 1297 CALL logger_fatal("VAR INIT: can not add value from variable "//& 1298 & TRIM(cd_name)//". invalid dimension to be used") 1299 ELSE 1300 dl_value(1,1,1,1) = dd_value(1) 1301 CALL logger_warn("VAR INIT: add scalar value for variable "//& 1302 & TRIM(cd_name)) 1303 1304 ENDIF 1283 1305 ENDIF 1284 1306 … … 6669 6691 ! check if variable is in array of variable structure 6670 6692 DO ji=1,il_size 6693 6671 6694 ! look for variable name 6672 6695 IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN … … 6683 6706 6684 6707 ELSE IF( PRESENT(cd_stdname) )THEN 6708 6685 6709 IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 6686 6710 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN … … 6690 6714 ENDIF 6691 6715 6716 ENDIF 6717 6692 6718 ! look for variable longname 6693 ELSEIF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.&6694 & 6719 IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 6720 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6695 6721 6696 6722 var_get_index=ji 6697 6723 EXIT 6724 6725 ELSE IF( PRESENT(cd_stdname) )THEN 6726 6727 IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.& 6728 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6729 6730 var_get_index=ji 6731 EXIT 6732 ENDIF 6698 6733 6699 6734 ENDIF … … 6734 6769 ! check if variable is in array of variable structure 6735 6770 DO ji=1,il_size 6771 6736 6772 ! look for variable name 6737 6773 IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN … … 6747 6783 EXIT 6748 6784 6749 ! look for variable long name 6750 ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 6751 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6752 6753 var_get_id=td_var(ji)%i_id 6754 EXIT 6755 6756 ELSE IF( PRESENT(cd_stdname) )THEN 6785 ELSE IF( PRESENT(cd_stdname) )THEN 6786 6757 6787 IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 6758 6788 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN … … 6761 6791 EXIT 6762 6792 ENDIF 6793 6794 ENDIF 6795 6796 ! look for variable long name 6797 IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 6798 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6799 6800 var_get_id=td_var(ji)%i_id 6801 EXIT 6802 6803 ELSE IF( PRESENT(cd_stdname) )THEN 6804 6805 IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.& 6806 & TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 6807 6808 var_get_id=td_var(ji)%i_id 6809 EXIT 6810 ENDIF 6811 6763 6812 ENDIF 6764 6813 … … 7176 7225 !------------------------------------------------------------------- 7177 7226 !> @brief 7227 !> This subroutine clean global array of variable structure 7228 !> with extra information: tg_varextra. 7229 !> 7230 !> @author J.Paul 7231 !> @date October, 2016 - Initial Version 7232 !------------------------------------------------------------------- 7233 SUBROUTINE var_clean_extra( ) 7234 IMPLICIT NONE 7235 ! Argument 7236 !---------------------------------------------------------------- 7237 7238 CALL var_clean(tg_varextra(:)) 7239 DEALLOCATE(tg_varextra) 7240 7241 END SUBROUTINE var_clean_extra 7242 !------------------------------------------------------------------- 7243 !> @brief 7178 7244 !> This subroutine read matrix value from character string in namelist 7179 !> and fill variable struc utre value.7245 !> and fill variable structure value. 7180 7246 !> 7181 7247 !> @details … … 8463 8529 ! loop indices 8464 8530 ! namelist 8465 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumvar8466 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumdim8467 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumatt8531 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar 8532 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim 8533 CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt 8468 8534 8469 8535 !---------------------------------------------------------------- … … 8526 8592 8527 8593 var_is_dummy=.FALSE. 8528 DO ji=1,ip_maxdum 8594 DO ji=1,ip_maxdumcfg 8529 8595 IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN 8530 8596 var_is_dummy=.TRUE.
Note: See TracChangeset
for help on using the changeset viewer.