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 10115 for NEMO/branches/2018/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/dimension.f90 – NEMO

Ignore:
Timestamp:
2018-09-12T15:59:13+02:00 (6 years ago)
Author:
cbricaud
Message:

phase 3.6 coarsening branch with nemo_3.6_rev9192

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2018/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/dimension.f90

    r7261 r10115  
    156156!> @date Spetember, 2015 
    157157!> - manage useless (dummy) dimension 
     158!> @date October, 2016 
     159!> - dimension allowed read in configuration file 
    158160!> 
    159161!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    171173 
    172174   PRIVATE :: cm_dumdim        !< dummy dimension array 
     175   PRIVATE :: cm_dimX          !< x dimension array 
     176   PRIVATE :: cm_dimY          !< y dimension array 
     177   PRIVATE :: cm_dimZ          !< z dimension array 
     178   PRIVATE :: cm_dimT          !< t dimension array 
    173179 
    174180   ! function and subroutine 
    … …  
    188194   PUBLIC :: dim_get_dummy     !< fill dummy dimension array 
    189195   PUBLIC :: dim_is_dummy      !< check if dimension is defined as dummy dimension 
     196   PUBLIC :: dim_def_extra     !< read dimension configuration file, and save dimension allowed. 
    190197 
    191198   PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t') 
    … …  
    203210   PRIVATE :: dim__copy_unit        ! copy dimension structure 
    204211   PRIVATE :: dim__copy_arr         ! copy array of dimension structure 
     212   PRIVATE :: dim__is_allowed 
    205213 
    206214   TYPE TDIM !< dimension structure 
    … …  
    215223   END TYPE 
    216224 
    217    CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumdim !< dummy dimension 
     225   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumdim !< dummy dimension 
     226   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimX   !< x dimension 
     227   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimY   !< y dimension 
     228   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimZ   !< z dimension 
     229   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimT   !< t dimension 
    218230 
    219231   INTERFACE dim_print 
    … …  
    587599         cl_name=fct_lower(cd_name) 
    588600 
    589          IF( TRIM(cl_name) == 'x' )THEN 
     601         IF(     dim__is_allowed(TRIM(cl_name), cm_dimX(:)) )THEN 
    590602            dim_init%c_sname='x' 
    591          ELSEIF( TRIM(cl_name) == 'y' )THEN 
     603         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimY(:)) )THEN 
    592604            dim_init%c_sname='y' 
    593          ELSEIF( TRIM(cl_name)== 'z' .OR. & 
    594          &       INDEX(cl_name,'depth')/=0 )THEN 
     605         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimZ(:)) )THEN 
    595606            dim_init%c_sname='z' 
    596          ELSEIF( TRIM(cl_name)== 't' .OR. & 
    597          &       INDEX(cl_name,'time')/=0 )THEN 
     607         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimT(:)) )THEN 
    598608            dim_init%c_sname='t' 
    599          ENDIF       
     609         ELSE 
     610            CALL logger_warn("DIM INIT: "//TRIM(cd_name)//& 
     611            " not allowed.") 
     612         ENDIF 
    600613 
    601614      ENDIF 
    … …  
    14301443      ! loop indices 
    14311444      ! namelist 
    1432       CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar 
    1433       CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim 
    1434       CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt 
     1445      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar 
     1446      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim 
     1447      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt 
    14351448 
    14361449      !---------------------------------------------------------------- 
    … …  
    14931506 
    14941507      dim_is_dummy=.FALSE. 
    1495       DO ji=1,ip_maxdum 
     1508      DO ji=1,ip_maxdumcfg 
    14961509         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN 
    14971510            dim_is_dummy=.TRUE. 
    … …  
    15011514 
    15021515   END FUNCTION dim_is_dummy 
     1516   !------------------------------------------------------------------- 
     1517   !> @brief This subroutine read dimension configuration file,  
     1518   !> and fill array of dimension allowed. 
     1519   !> 
     1520   !> @author J.Paul 
     1521   !> @date Ocotber, 2016 - Initial Version 
     1522   ! 
     1523   !> @param[in] cd_file input file (dimension configuration file) 
     1524   !------------------------------------------------------------------- 
     1525   SUBROUTINE dim_def_extra( cd_file ) 
     1526      IMPLICIT NONE 
     1527 
     1528      ! Argument       
     1529      CHARACTER(LEN=*), INTENT(IN) :: cd_file 
     1530 
     1531      ! local variable 
     1532      INTEGER(i4)   :: il_fileid 
     1533      INTEGER(i4)   :: il_status 
     1534 
     1535      LOGICAL       :: ll_exist 
     1536       
     1537      ! loop indices 
     1538      ! namelist 
     1539      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimX = ''  
     1540      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimY = '' 
     1541      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimZ = '' 
     1542      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimT = '' 
     1543 
     1544      !---------------------------------------------------------------- 
     1545      NAMELIST /namdim/ &   !< dimension namelist 
     1546      &  cn_dimX, &       !< x dimension name allowed 
     1547      &  cn_dimY, &       !< y dimension name allowed 
     1548      &  cn_dimZ, &       !< z dimension name allowed 
     1549      &  cn_dimT          !< t dimension name allowed 
     1550 
     1551      !---------------------------------------------------------------- 
     1552 
     1553      ! init 
     1554      cm_dimX(:)='' 
     1555      cm_dimY(:)='' 
     1556      cm_dimZ(:)='' 
     1557      cm_dimT(:)='' 
     1558 
     1559      ! read config variable file 
     1560      INQUIRE(FILE=TRIM(cd_file), EXIST=ll_exist) 
     1561      IF( ll_exist )THEN 
     1562 
     1563         il_fileid=fct_getunit() 
     1564    
     1565         OPEN( il_fileid, FILE=TRIM(cd_file), & 
     1566         &                FORM='FORMATTED',       & 
     1567         &                ACCESS='SEQUENTIAL',    & 
     1568         &                STATUS='OLD',           & 
     1569         &                ACTION='READ',          & 
     1570         &                IOSTAT=il_status) 
     1571         CALL fct_err(il_status) 
     1572         IF( il_status /= 0 )THEN 
     1573            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_file)) 
     1574         ENDIF 
     1575    
     1576         READ( il_fileid, NML = namdim ) 
     1577         cm_dimX(:)=cn_dimX(:) 
     1578         cm_dimY(:)=cn_dimY(:) 
     1579         cm_dimZ(:)=cn_dimZ(:) 
     1580         cm_dimT(:)=cn_dimT(:) 
     1581 
     1582         CLOSE( il_fileid ) 
     1583 
     1584      ELSE 
     1585 
     1586         CALL logger_fatal("DIM DEF EXTRA: can't find configuration"//& 
     1587            &              " file "//TRIM(cd_file)) 
     1588 
     1589      ENDIF          
     1590 
     1591   END SUBROUTINE dim_def_extra 
     1592   !------------------------------------------------------------------- 
     1593   !> @brief This function check if dimension is allowed, i.e defined  
     1594   !> in dimension configuraton file 
     1595   !> 
     1596   !> @author J.Paul 
     1597   !> @date OCTOber, 2016 - Initial Version 
     1598   ! 
     1599   !> @param[in] cd_name dimension name 
     1600   !> @param[in] cd_dim  array dimension name allowed 
     1601   !> @return true if dimension is allowed  
     1602   !------------------------------------------------------------------- 
     1603   FUNCTION dim__is_allowed(cd_name, cd_dim) 
     1604      IMPLICIT NONE 
     1605 
     1606      ! Argument 
     1607      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
     1608      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_dim 
     1609       
     1610      ! function 
     1611      LOGICAL :: dim__is_allowed 
     1612       
     1613      ! loop indices 
     1614      INTEGER(i4) :: ji 
     1615      !---------------------------------------------------------------- 
     1616 
     1617      dim__is_allowed=.FALSE. 
     1618      ji=1 
     1619      DO WHILE( TRIM(cd_dim(ji)) /= '' ) 
     1620         IF( TRIM(fct_lower(cd_name)) == TRIM(fct_lower(cd_dim(ji))) )THEN 
     1621            dim__is_allowed=.TRUE. 
     1622            EXIT 
     1623         ENDIF 
     1624         ji=ji+1 
     1625      ENDDO 
     1626 
     1627   END FUNCTION dim__is_allowed 
     1628 
    15031629END MODULE dim 
    15041630 
Note: See TracChangeset for help on using the changeset viewer.