New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 7153 for branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/variable.f90 – NEMO

Ignore:
Timestamp:
2016-10-28T11:13:57+02:00 (8 years ago)
Author:
jpaul
Message:

see ticket #1781

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/variable.f90

    r6393 r7153  
    3434!>    Note:<br/> 
    3535!>       - others optionals arguments could be added, see var_init. 
    36 !>       - to put variable 0D, use td_dim with all dimension unused 
     36!>       - to put scalar variable (OD), use td_dim with all dimension unused 
    3737!> (td_dim(:)%l_use=.FALSE.) 
    3838!>     
     
    267267!>    - cd_varinfo is variable information from namelist 
    268268!> 
     269!>    to clean global array of variable structure:<br/> 
     270!>@code 
     271!>    CALL var_clean_extra( ) 
     272!>@endcode 
     273!> 
    269274!>    to check variable dimension expected, as defined in file 'variable.cfg':<br/> 
    270275!>@code 
     
    287292!> @date Spetember, 2015 
    288293!> - 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!> 
    290298!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    291299!---------------------------------------------------------------------- 
     
    337345   PUBLIC :: var_def_extra     !< read variable configuration file, and save extra information. 
    338346   PUBLIC :: var_chg_extra     !< read variable namelist information, and modify extra information. 
     347   PUBLIC :: var_clean_extra   !< clean gloabl array of extra information. 
    339348   PUBLIC :: var_check_dim     !< check variable dimension expected 
    340349   PUBLIC :: var_get_dummy     !< fill dummy variable array 
     
    416425      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim           !< variable dimension 
    417426  
    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 
    419429 
    420430      ! highlight some attributes 
     
    451461                                                        !< fill when running var_def_extra()  
    452462 
    453    CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumvar !< dummy variable 
     463   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumvar !< dummy variable 
    454464 
    455465   INTERFACE var_init 
     
    593603         CALL att_clean(tl_att) 
    594604      ENDIF 
     605 
     606      var__copy_unit%l_file     = td_var%l_file 
     607      var__copy_unit%l_use      = td_var%l_use 
    595608 
    596609      ! copy highlight attribute 
     
    66696682      ! check if variable is in array of variable structure 
    66706683      DO ji=1,il_size 
     6684 
    66716685         ! look for variable name 
    66726686         IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN 
     
    66836697 
    66846698         ELSE IF( PRESENT(cd_stdname) )THEN  
     6699 
    66856700            IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 
    66866701            &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 
     
    66906705            ENDIF 
    66916706 
     6707         ENDIF 
     6708 
    66926709         ! look for variable longname 
    6693          ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 
    6694          &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 
     6710         IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 
     6711         &   TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 
    66956712             
    66966713            var_get_index=ji 
    66976714            EXIT 
     6715 
     6716         ELSE IF( PRESENT(cd_stdname) )THEN 
     6717 
     6718            IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.& 
     6719            &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 
     6720             
     6721               var_get_index=ji 
     6722               EXIT 
     6723            ENDIF 
    66986724 
    66996725         ENDIF 
     
    67346760      ! check if variable is in array of variable structure 
    67356761      DO ji=1,il_size 
     6762       
    67366763         ! look for variable name 
    67376764         IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN 
     
    67476774            EXIT 
    67486775 
    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  
     6776         ELSE IF( PRESENT(cd_stdname) )THEN 
     6777 
    67576778            IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 
    67586779            &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 
     
    67616782               EXIT 
    67626783            ENDIF 
     6784 
     6785         ENDIF 
     6786 
     6787         ! look for variable long name 
     6788         IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 
     6789         &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 
     6790             
     6791            var_get_id=td_var(ji)%i_id 
     6792            EXIT 
     6793 
     6794         ELSE IF( PRESENT(cd_stdname) )THEN  
     6795 
     6796            IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.& 
     6797            &    TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 
     6798             
     6799               var_get_id=td_var(ji)%i_id 
     6800               EXIT 
     6801            ENDIF 
     6802 
    67636803         ENDIF 
    67646804 
     
    71767216   !------------------------------------------------------------------- 
    71777217   !> @brief 
     7218   !> This subroutine clean global array of variable structure  
     7219   !> with extra information: tg_varextra. 
     7220   !>  
     7221   !> @author J.Paul 
     7222   !> @date October, 2016 - Initial Version 
     7223   !------------------------------------------------------------------- 
     7224   SUBROUTINE var_clean_extra( ) 
     7225      IMPLICIT NONE 
     7226      ! Argument 
     7227      !---------------------------------------------------------------- 
     7228 
     7229      CALL var_clean(tg_varextra(:)) 
     7230      DEALLOCATE(tg_varextra) 
     7231 
     7232   END SUBROUTINE var_clean_extra 
     7233   !------------------------------------------------------------------- 
     7234   !> @brief 
    71787235   !> This subroutine read matrix value from character string in namelist 
    71797236   !> and fill variable strucutre value. 
     
    84638520      ! loop indices 
    84648521      ! 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 
     8522      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar 
     8523      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim 
     8524      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt 
    84688525 
    84698526      !---------------------------------------------------------------- 
     
    85268583 
    85278584      var_is_dummy=.FALSE. 
    8528       DO ji=1,ip_maxdum 
     8585      DO ji=1,ip_maxdumcfg 
    85298586         IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN 
    85308587            var_is_dummy=.TRUE. 
Note: See TracChangeset for help on using the changeset viewer.