- Timestamp:
- 2016-03-17T10:15:57+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/variable.f90
r5616 r6392 285 285 !> @date July, 2015 286 286 !> - add subroutine var_chg_unit to change unit of output variable 287 !> @date Spetember, 2015 288 !> - manage useless (dummy) variable 287 289 ! 288 290 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 305 307 306 308 PUBLIC :: tg_varextra !< array of variable structure with extra information. 309 310 PRIVATE :: cm_dumvar !< dummy variable array 307 311 308 312 ! function and subroutine … … 334 338 PUBLIC :: var_chg_extra !< read variable namelist information, and modify extra information. 335 339 PUBLIC :: var_check_dim !< check variable dimension expected 340 PUBLIC :: var_get_dummy !< fill dummy variable array 341 PUBLIC :: var_is_dummy !< check if variable is defined as dummy variable 336 342 337 343 PRIVATE :: var__init ! initialize variable structure without array of value … … 445 451 !< fill when running var_def_extra() 446 452 453 CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumvar !< dummy variable 454 447 455 INTERFACE var_init 448 456 MODULE PROCEDURE var__init ! initialize variable structure without array of value … … 6698 6706 !> given variable name or standard name. 6699 6707 !> 6700 !> @warning only variable read from file, have an id.6701 !>6702 6708 !> @author J.Paul 6703 6709 !> @date November, 2013 - Initial Version 6710 !> @date July, 2015 6711 !> - check long name 6704 6712 ! 6705 6713 !> @param[in] td_var array of variable structure … … 6735 6743 ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.& 6736 6744 & TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 6745 6746 var_get_id=td_var(ji)%i_id 6747 EXIT 6748 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 6737 6752 6738 6753 var_get_id=td_var(ji)%i_id … … 6775 6790 IF( ASSOCIATED(td_var%d_value) )THEN 6776 6791 6777 CALL logger_trace( "VAR GET MASK: create mask from variable "//& 6778 & TRIM(td_var%c_name) ) 6792 CALL logger_debug( "VAR GET MASK: create mask from variable "//& 6793 & TRIM(td_var%c_name)//", FillValue ="//& 6794 & TRIM(fct_str(td_var%d_fill))) 6779 6795 var_get_mask(:,:,:)=1 6780 6796 WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill ) … … 7279 7295 7280 7296 ! local variable 7297 CHARACTER(LEN=lc) :: cl_tmp 7298 7281 7299 INTEGER(i4) :: il_ind 7300 7282 7301 TYPE(TATT) :: tl_att 7283 7302 7284 7303 ! loop indices 7304 INTEGER(i4) :: ji 7285 7305 !---------------------------------------------------------------- 7286 7306 … … 7335 7355 td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis) 7336 7356 ! create attibute 7337 tl_att=att_init('axis',TRIM(td_var%c_axis)) 7338 CALL var_move_att(td_var, tl_att) 7357 IF( TRIM(fct_upper(td_var%c_name)) == TRIM(td_var%c_axis) )THEN 7358 tl_att=att_init('axis',TRIM(td_var%c_axis)) 7359 ELSE 7360 cl_tmp="" 7361 DO ji=LEN(TRIM(td_var%c_axis)),1,-1 7362 cl_tmp=TRIM(cl_tmp)//" "//TRIM(td_var%c_axis(ji:ji)) 7363 ENDDO 7364 tl_att=att_init('associate',TRIM(ADJUSTL(cl_tmp))) 7365 ENDIF 7366 CALL var_move_att(td_var, tl_att) 7339 7367 ENDIF 7340 7368 … … 7402 7430 ENDIF 7403 7431 7432 ELSE 7433 CALL logger_warn("VAR GET EXTRA: no extra information on "//& 7434 & "variable "//TRIM(td_var%c_name)//". you should define it"//& 7435 & " (see variable.cfg).") 7404 7436 ENDIF 7405 7437 … … 7425 7457 !> - change way to get information in namelist, 7426 7458 !> value follows string "min =" 7459 !> @date Feb, 2016 7460 !> - check character just after keyword 7427 7461 ! 7428 7462 !> @param[in] cd_name variable name … … 7447 7481 ! loop indices 7448 7482 INTEGER(i4) :: ji 7483 INTEGER(i4) :: jj 7449 7484 !---------------------------------------------------------------- 7450 7485 ! init … … 7457 7492 il_ind=INDEX(TRIM(cl_tmp),'min') 7458 7493 IF( il_ind /= 0 )THEN 7459 cl_min=fct_split(cl_tmp,2,'=') 7460 EXIT 7494 ! check character just after 7495 jj=il_ind+LEN('min') 7496 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7497 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7498 cl_min=fct_split(cl_tmp,2,'=') 7499 EXIT 7500 ENDIF 7461 7501 ENDIF 7462 7502 ji=ji+1 … … 7470 7510 & TRIM(fct_str(var__get_min))//" for variable "//TRIM(cd_name) ) 7471 7511 ELSE 7472 CALL logger_error("VAR GET MIN: invalid minimum value for "//& 7473 & "variable "//TRIM(cd_name)//". check namelist." ) 7512 CALL logger_error("VAR GET MIN: invalid minimum value ("//& 7513 & TRIM(cl_min)//") for variable "//TRIM(cd_name)//& 7514 & ". check namelist." ) 7474 7515 ENDIF 7475 7516 ENDIF … … 7489 7530 !> - change way to get information in namelist, 7490 7531 !> value follows string "max =" 7532 !> @date Feb, 2016 7533 !> - check character just after keyword 7491 7534 ! 7492 7535 !> @param[in] cd_name variable name … … 7511 7554 ! loop indices 7512 7555 INTEGER(i4) :: ji 7556 INTEGER(i4) :: jj 7513 7557 !---------------------------------------------------------------- 7514 7558 ! init … … 7521 7565 il_ind=INDEX(TRIM(cl_tmp),'max') 7522 7566 IF( il_ind /= 0 )THEN 7523 cl_max=fct_split(cl_tmp,2,'=') 7524 EXIT 7567 ! check character just after 7568 jj=il_ind+LEN('max') 7569 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7570 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7571 cl_max=fct_split(cl_tmp,2,'=') 7572 EXIT 7573 ENDIF 7525 7574 ENDIF 7526 7575 ji=ji+1 … … 7550 7599 !> @author J.Paul 7551 7600 !> @date June, 2015 - Initial Version 7601 !> @date Feb, 2016 7602 !> - check character just after keyword 7552 7603 ! 7553 7604 !> @param[in] cd_name variable name … … 7574 7625 ! loop indices 7575 7626 INTEGER(i4) :: ji 7627 INTEGER(i4) :: jj 7576 7628 !---------------------------------------------------------------- 7577 7629 ! init … … 7584 7636 il_ind=INDEX(TRIM(cl_tmp),'unf') 7585 7637 IF( il_ind /= 0 )THEN 7586 cl_unf=fct_split(cl_tmp,2,'=') 7587 EXIT 7638 ! check character just after 7639 jj=il_ind+LEN('unf') 7640 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7641 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7642 cl_unf=fct_split(cl_tmp,2,'=') 7643 EXIT 7644 ENDIF 7588 7645 ENDIF 7589 7646 ji=ji+1 … … 7626 7683 !> - change way to get information in namelist, 7627 7684 !> value follows string "int =" 7685 !> @date Feb, 2016 7686 !> - check character just after keyword 7628 7687 ! 7629 7688 !> @param[in] cd_name variable name … … 7663 7722 il_ind=INDEX(TRIM(cl_tmp),'int') 7664 7723 IF( il_ind /= 0 )THEN 7665 cl_int=fct_split(cl_tmp,2,'=') 7666 EXIT 7724 ! check character just after 7725 jj=il_ind+LEN('int') 7726 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7727 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7728 cl_int=fct_split(cl_tmp,2,'=') 7729 EXIT 7730 ENDIF 7667 7731 ENDIF 7668 7732 ji=ji+1 … … 7746 7810 !> - change way to get information in namelist, 7747 7811 !> value follows string "ext =" 7812 !> @date Feb, 2016 7813 !> - check character just after keyword 7748 7814 ! 7749 7815 !> @param[in] cd_name variable name … … 7778 7844 il_ind=INDEX(TRIM(cl_tmp),'ext') 7779 7845 IF( il_ind /= 0 )THEN 7780 cl_ext=fct_split(cl_tmp,2,'=') 7781 EXIT 7846 ! check character just after 7847 jj=il_ind+LEN('ext') 7848 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7849 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7850 cl_ext=fct_split(cl_tmp,2,'=') 7851 EXIT 7852 ENDIF 7782 7853 ENDIF 7783 7854 ji=ji+1 … … 7822 7893 !> - change way to get information in namelist, 7823 7894 !> value follows string "flt =" 7895 !> @date Feb, 2016 7896 !> - check character just after keyword 7824 7897 !> 7825 7898 !> @param[in] cd_name variable name … … 7852 7925 il_ind=INDEX(TRIM(cl_tmp),'flt') 7853 7926 IF( il_ind /= 0 )THEN 7854 cl_flt=fct_split(cl_tmp,2,'=') 7855 EXIT 7927 ! check character just after 7928 jj=il_ind+LEN('flt') 7929 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 7930 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 7931 cl_flt=fct_split(cl_tmp,2,'=') 7932 EXIT 7933 ENDIF 7856 7934 ENDIF 7857 7935 ji=ji+1 … … 7925 8003 !> @author J.Paul 7926 8004 !> @date June, 2015 - Initial Version 8005 !> @date Feb, 2016 8006 !> - check character just after keyword 7927 8007 ! 7928 8008 !> @param[in] cd_name variable name … … 7946 8026 ! loop indices 7947 8027 INTEGER(i4) :: ji 8028 INTEGER(i4) :: jj 7948 8029 !---------------------------------------------------------------- 7949 8030 … … 7955 8036 il_ind=INDEX(TRIM(cl_tmp),'unt') 7956 8037 IF( il_ind /= 0 )THEN 7957 var__get_unt=fct_split(cl_tmp,2,'=') 7958 EXIT 8038 ! check character just after 8039 jj=il_ind+LEN('unt') 8040 IF( TRIM(cl_tmp(jj:jj)) == ' ' .OR. & 8041 & TRIM(cl_tmp(jj:jj)) == '=' )THEN 8042 var__get_unt=fct_split(cl_tmp,2,'=') 8043 EXIT 8044 ENDIF 7959 8045 ENDIF 7960 8046 ji=ji+1 … … 8101 8187 8102 8188 !- change scale factor and offset to avoid mistake 8103 tl_att=att_init('scale_factor',1 )8189 tl_att=att_init('scale_factor',1._dp) 8104 8190 CALL var_move_att(td_var, tl_att) 8105 8191 8106 tl_att=att_init('add_offset',0 )8192 tl_att=att_init('add_offset',0._dp) 8107 8193 CALL var_move_att(td_var, tl_att) 8108 8194 ENDIF … … 8356 8442 8357 8443 END FUNCTION var_to_date 8444 !------------------------------------------------------------------- 8445 !> @brief This subroutine fill dummy variable array 8446 ! 8447 !> @author J.Paul 8448 !> @date September, 2015 - Initial Version 8449 ! 8450 !> @param[in] cd_dummy dummy configuration file 8451 !------------------------------------------------------------------- 8452 SUBROUTINE var_get_dummy( cd_dummy ) 8453 IMPLICIT NONE 8454 ! Argument 8455 CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 8456 8457 ! local variable 8458 INTEGER(i4) :: il_fileid 8459 INTEGER(i4) :: il_status 8460 8461 LOGICAL :: ll_exist 8462 8463 ! loop indices 8464 ! namelist 8465 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 8466 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 8467 CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 8468 8469 !---------------------------------------------------------------- 8470 NAMELIST /namdum/ & !< dummy namelist 8471 & cn_dumvar, & !< variable name 8472 & cn_dumdim, & !< dimension name 8473 & cn_dumatt !< attribute name 8474 !---------------------------------------------------------------- 8475 8476 ! init 8477 cm_dumvar(:)='' 8478 8479 ! read namelist 8480 INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 8481 IF( ll_exist )THEN 8482 8483 il_fileid=fct_getunit() 8484 8485 OPEN( il_fileid, FILE=TRIM(cd_dummy), & 8486 & FORM='FORMATTED', & 8487 & ACCESS='SEQUENTIAL', & 8488 & STATUS='OLD', & 8489 & ACTION='READ', & 8490 & IOSTAT=il_status) 8491 CALL fct_err(il_status) 8492 IF( il_status /= 0 )THEN 8493 CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 8494 ENDIF 8495 8496 READ( il_fileid, NML = namdum ) 8497 cm_dumvar(:)=cn_dumvar(:) 8498 8499 CLOSE( il_fileid ) 8500 8501 ENDIF 8502 8503 END SUBROUTINE var_get_dummy 8504 !------------------------------------------------------------------- 8505 !> @brief This function check if variable is defined as dummy variable 8506 !> in configuraton file 8507 !> 8508 !> @author J.Paul 8509 !> @date September, 2015 - Initial Version 8510 ! 8511 !> @param[in] td_var variable structure 8512 !> @return true if variable is dummy variable 8513 !------------------------------------------------------------------- 8514 FUNCTION var_is_dummy(td_var) 8515 IMPLICIT NONE 8516 8517 ! Argument 8518 TYPE(TVAR), INTENT(IN) :: td_var 8519 8520 ! function 8521 LOGICAL :: var_is_dummy 8522 8523 ! loop indices 8524 INTEGER(i4) :: ji 8525 !---------------------------------------------------------------- 8526 8527 var_is_dummy=.FALSE. 8528 DO ji=1,ip_maxdum 8529 IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN 8530 var_is_dummy=.TRUE. 8531 EXIT 8532 ENDIF 8533 ENDDO 8534 8535 END FUNCTION var_is_dummy 8358 8536 END MODULE var 8359 8537
Note: See TracChangeset
for help on using the changeset viewer.
