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 7646 for trunk/NEMOGCM/TOOLS/SIREN/src/variable.f90 – NEMO

Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (7 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/TOOLS/SIREN/src/variable.f90

    r6393 r7646  
    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 
    … …  
    11261139   !> @date July, 2015 
    11271140   !> - add unit factor (to change unit) 
     1141   !> @date November, 2016 
     1142   !> - allow to add scalar value 
    11281143   !> 
    11291144   !> @param[in] cd_name         variable name 
    … …  
    12791294         dl_value(1,1,1,:) = dd_value(:) 
    12801295      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 
    12831305      ENDIF 
    12841306 
    … …  
    66696691      ! check if variable is in array of variable structure 
    66706692      DO ji=1,il_size 
     6693 
    66716694         ! look for variable name 
    66726695         IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN 
    … …  
    66836706 
    66846707         ELSE IF( PRESENT(cd_stdname) )THEN  
     6708 
    66856709            IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 
    66866710            &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 
    … …  
    66906714            ENDIF 
    66916715 
     6716         ENDIF 
     6717 
    66926718         ! 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 
     6719         IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.& 
     6720         &   TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN 
    66956721             
    66966722            var_get_index=ji 
    66976723            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 
    66986733 
    66996734         ENDIF 
    … …  
    67346769      ! check if variable is in array of variable structure 
    67356770      DO ji=1,il_size 
     6771       
    67366772         ! look for variable name 
    67376773         IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN 
    … …  
    67476783            EXIT 
    67486784 
    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 
    67576787            IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.& 
    67586788            &    TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN 
    … …  
    67616791               EXIT 
    67626792            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 
    67636812         ENDIF 
    67646813 
    … …  
    71767225   !------------------------------------------------------------------- 
    71777226   !> @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 
    71787244   !> This subroutine read matrix value from character string in namelist 
    7179    !> and fill variable strucutre value. 
     7245   !> and fill variable structure value. 
    71807246   !> 
    71817247   !> @details 
    … …  
    84638529      ! loop indices 
    84648530      ! 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 
     8531      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 
    84688534 
    84698535      !---------------------------------------------------------------- 
    … …  
    85268592 
    85278593      var_is_dummy=.FALSE. 
    8528       DO ji=1,ip_maxdum 
     8594      DO ji=1,ip_maxdumcfg 
    85298595         IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN 
    85308596            var_is_dummy=.TRUE. 
Note: See TracChangeset for help on using the changeset viewer.