- Timestamp:
- 2017-11-30T16:58:49+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/SIREN/src/dimension.f90
r6392 r8862 156 156 !> @date Spetember, 2015 157 157 !> - manage useless (dummy) dimension 158 !> @date October, 2016 159 !> - dimension allowed read in configuration file 158 160 !> 159 161 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 171 173 172 174 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 173 179 174 180 ! function and subroutine … … 188 194 PUBLIC :: dim_get_dummy !< fill dummy dimension array 189 195 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. 190 197 191 198 PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t') … … 203 210 PRIVATE :: dim__copy_unit ! copy dimension structure 204 211 PRIVATE :: dim__copy_arr ! copy array of dimension structure 212 PRIVATE :: dim__is_allowed 205 213 206 214 TYPE TDIM !< dimension structure … … 215 223 END TYPE 216 224 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 218 230 219 231 INTERFACE dim_print … … 587 599 cl_name=fct_lower(cd_name) 588 600 589 IF( TRIM(cl_name) == 'x')THEN601 IF( dim__is_allowed(TRIM(cl_name), cm_dimX(:)) )THEN 590 602 dim_init%c_sname='x' 591 ELSEIF( TRIM(cl_name) == 'y')THEN603 ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimY(:)) )THEN 592 604 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 595 606 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 598 608 dim_init%c_sname='t' 599 ENDIF 609 ELSE 610 CALL logger_warn("DIM INIT: "//TRIM(cd_name)//& 611 " not allowed.") 612 ENDIF 600 613 601 614 ENDIF … … 1430 1443 ! loop indices 1431 1444 ! namelist 1432 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumvar1433 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumdim1434 CHARACTER(LEN=lc), DIMENSION(ip_maxdum ) :: cn_dumatt1445 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 1435 1448 1436 1449 !---------------------------------------------------------------- … … 1493 1506 1494 1507 dim_is_dummy=.FALSE. 1495 DO ji=1,ip_maxdum 1508 DO ji=1,ip_maxdumcfg 1496 1509 IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN 1497 1510 dim_is_dummy=.TRUE. … … 1501 1514 1502 1515 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 1503 1629 END MODULE dim 1504 1630
Note: See TracChangeset
for help on using the changeset viewer.