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

Ignore:
Timestamp:
2016-11-18T09:34:22+01:00 (7 years ago)
Author:
cbricaud
Message:

phaze the rest of NEMOGCM directory ( all except NEMO directory) of the CRS branch with nemo_v3_6_STABLE branch at rev 7213 (09-09-2016) (merge -r 5519:7213 )

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/dimension.f90

    r5602 r7261  
    7878!> 
    7979!>    This subroutine filled dimension structure with unused dimension,  
    80 !>    then switch from "unordered" dimension to "ordered" dimension.<br/> 
     80!>    then switch from "disordered" dimension to "ordered" dimension.<br/> 
    8181!>    The dimension structure return will be:<br/> 
    8282!>    tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/> 
    … …  
    9494!>    - cl_neworder : character(len=4) (example: 'yxzt') 
    9595!> 
    96 !>    to switch dimension array from ordered dimension to unordered 
     96!>    to switch dimension array from ordered dimension to disordered 
    9797!> dimension:<br/> 
    9898!> @code 
    99 !>    CALL dim_unorder(tl_dim(:)) 
     99!>    CALL dim_disorder(tl_dim(:)) 
    100100!> @endcode 
    101101!> 
    … …  
    111111!>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:)) 
    112112!> @endcode 
    113 !>       - value must be a 4D array of real(8) value "unordered" 
    114 !> 
    115 !>    to reshape array of value in "unordered" dimension:<br/> 
     113!>       - value must be a 4D array of real(8) value "disordered" 
     114!> 
     115!>    to reshape array of value in "disordered" dimension:<br/> 
    116116!> @code 
    117117!>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:)) 
    … …  
    123123!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:)) 
    124124!> @endcode 
    125 !>       - tab must be a 1D array with 4 elements "unordered". 
     125!>       - tab must be a 1D array with 4 elements "disordered". 
    126126!>       It could be composed of character, integer(4), or logical 
    127127!>  
    128 !>    to reorder a 1D array of 4 elements in "unordered" dimension:<br/> 
     128!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/> 
    129129!> @code 
    130 !>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:)) 
     130!>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:)) 
    131131!> @endcode 
    132132!>       - tab must be a 1D array with 4 elements "ordered". 
    … …  
    154154! REVISION HISTORY: 
    155155!> @date November, 2013 - Initial Version 
     156!> @date Spetember, 2015 
     157!> - manage useless (dummy) dimension 
    156158!> 
    157159!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    168170   PUBLIC :: TDIM              !< dimension structure 
    169171 
     172   PRIVATE :: cm_dumdim        !< dummy dimension array 
     173 
    170174   ! function and subroutine 
    171175   PUBLIC :: dim_init          !< initialize dimension structure 
    … …  
    173177   PUBLIC :: dim_print         !< print dimension information 
    174178   PUBLIC :: dim_copy          !< copy dimension structure 
    175    PUBLIC :: dim_reorder       !< filled dimension structure to switch from unordered to ordered dimension 
    176    PUBLIC :: dim_unorder       !< switch dimension array from ordered to unordered dimension 
     179   PUBLIC :: dim_reorder       !< filled dimension structure to switch from disordered to ordered dimension 
     180   PUBLIC :: dim_disorder      !< switch dimension array from ordered to disordered dimension 
    177181   PUBLIC :: dim_fill_unused   !< filled dimension structure with unused dimension  
    178182   PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t') 
    … …  
    182186   PUBLIC :: dim_get_index     !< get dimension index in array of dimension structure 
    183187   PUBLIC :: dim_get_id        !< get dimension id in array of dimension structure 
     188   PUBLIC :: dim_get_dummy     !< fill dummy dimension array 
     189   PUBLIC :: dim_is_dummy      !< check if dimension is defined as dummy dimension 
    184190 
    185191   PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t') 
    … …  
    209215   END TYPE 
    210216 
     217   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumdim !< dummy dimension 
     218 
    211219   INTERFACE dim_print 
    212220      MODULE PROCEDURE dim__print_unit ! print information on one dimension 
    … …  
    321329   !> @author J.Paul 
    322330   !> @date November, 2013 - Initial Version 
    323    !> @date September, 2014 - do not check if dimension used 
     331   !> @date September, 2014  
     332   !> - do not check if dimension used 
    324333   !> 
    325334   !> @param[in] td_dim    array of dimension structure 
    … …  
    502511   !> Optionally length could be inform, as well as short name and if dimension 
    503512   !> is unlimited or not.<br/> 
    504    !> define dimension is supposed to be used. 
    505    !> 
    506    !> @author J.Paul 
    507    !> @date November, 2013 - Initial Version 
     513   !> By default, define dimension is supposed to be used. 
     514   !> Optionally you could force a defined dimension to be unused.  
     515   !> 
     516   !> @author J.Paul 
     517   !> @date November, 2013 - Initial Version 
     518   !> @date February, 2015  
     519   !> - add optional argument to define dimension unused 
     520   !> @date July, 2015 
     521   !> - Bug fix: inform order to disorder table instead of disorder to order 
     522   !> table 
    508523   ! 
    509524   !> @param[in] cd_name   dimension name 
    … …  
    511526   !> @param[in] ld_uld    dimension unlimited 
    512527   !> @param[in] cd_sname  dimension short name 
     528   !> @param[in] ld_use    dimension use or not 
    513529   !> @return dimension structure 
    514530   !------------------------------------------------------------------- 
    515    TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname) 
     531   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use ) 
    516532      IMPLICIT NONE 
    517533 
    … …  
    521537      LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld 
    522538      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname 
     539      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use 
    523540 
    524541      ! local variable 
    … …  
    543560 
    544561      ! define dimension is supposed to be used 
    545       dim_init%l_use=.TRUE. 
     562      IF( PRESENT(ld_use) )THEN 
     563         dim_init%l_use=ld_use 
     564      ELSE 
     565         dim_init%l_use=.TRUE. 
     566      ENDIF 
    546567 
    547568      IF( PRESENT(cd_sname) )THEN 
    … …  
    590611      ENDIF 
    591612       
    592       ! get dimension orderer index 
    593       dim_init%i_2xyzt=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname)) 
     613      ! get dimension order indices 
     614      dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname)) 
    594615 
    595616   END FUNCTION dim_init 
    … …  
    655676   !> @author J.Paul 
    656677   !> @date November, 2013 - Initial Version 
     678   !> @date July, 2015  
     679   !> - Bug fix: use order to disorder table (see dim_init) 
    657680   !> 
    658681   !> @param[in] td_dim array of dimension structure 
    … …  
    686709         ! search missing dimension 
    687710         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN 
    688             ! search first empty dimension 
    689             il_ind(:)=MINLOC( tl_dim(:)%i_2xyzt, tl_dim(:)%i_2xyzt == 0 ) 
     711            ! search first empty dimension (see dim_init) 
     712            il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 ) 
    690713 
    691714            ! put missing dimension instead of empty one 
    … …  
    693716            ! update output structure 
    694717            tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji)) 
    695             tl_dim(il_ind(1))%i_2xyzt=ji 
     718            tl_dim(il_ind(1))%i_xyzt2=ji 
    696719            tl_dim(il_ind(1))%i_len=1 
    697720            tl_dim(il_ind(1))%l_use=.FALSE. 
    … …  
    711734   !> This subroutine switch element of an array (4 elts) of dimension  
    712735   !> structure  
    713    !> from unordered dimension to ordered dimension <br/> 
     736   !> from disordered dimension to ordered dimension <br/> 
    714737   !> 
    715738   !> @details 
    … …  
    722745   !> @author J.Paul 
    723746   !> @date November, 2013 - Initial Version 
    724    !> @date September, 2014 - allow to choose ordered dimension to be output 
     747   !> @date September, 2014  
     748   !> - allow to choose ordered dimension to be output 
    725749   !> 
    726750   !> @param[inout] td_dim    array of dimension structure 
    … …  
    811835   !------------------------------------------------------------------- 
    812836   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t') 
    813    !> to unordered dimension. <br/> 
     837   !> to disordered dimension. <br/> 
    814838   !> @details 
    815839   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/> 
    … …  
    822846   !> @param[inout] td_dim array of dimension structure 
    823847   !------------------------------------------------------------------- 
    824    SUBROUTINE dim_unorder(td_dim) 
     848   SUBROUTINE dim_disorder(td_dim) 
    825849      IMPLICIT NONE 
    826850      ! Argument       
    … …  
    835859 
    836860      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    837          CALL logger_error("DIM UNORDER: invalid dimension of array dimension.") 
     861         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.") 
    838862      ELSE       
    839863         ! add dummy xyzt2 id to unused dimension 
    … …  
    868892      ENDIF 
    869893 
    870    END SUBROUTINE dim_unorder 
     894   END SUBROUTINE dim_disorder 
    871895   !------------------------------------------------------------------- 
    872896   !> @brief This function reshape real(8) 4D array    
    … …  
    908932 
    909933      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    910          CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of array dimension.") 
     934         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//& 
     935            &  "array dimension.") 
    911936      ELSE       
    912937 
    … …  
    914939 
    915940            CALL logger_fatal( & 
    916             &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder & 
    917             &     before running RESHAPE" ) 
     941            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// & 
     942            &  "   before running RESHAPE" ) 
    918943 
    919944         ENDIF 
    … …  
    972997   !------------------------------------------------------------------- 
    973998   !> @brief This function reshape ordered real(8) 4D array with dimension  
    974    !> (/'x','y','z','t'/) to an "unordered" array.<br/> 
     999   !> (/'x','y','z','t'/) to an "disordered" array.<br/> 
    9751000   !> @details 
    9761001   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/) 
    … …  
    10091034 
    10101035      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    1011          CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of array dimension.") 
     1036         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//& 
     1037            &  "array dimension.") 
    10121038      ELSE 
    10131039 
    … …  
    10151041 
    10161042            CALL logger_fatal( & 
    1017             &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder & 
    1018             &     before running RESHAPE" ) 
     1043            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// & 
     1044            &  "   before running RESHAPE" ) 
    10191045 
    10201046         ENDIF         
    … …  
    11041130 
    11051131            CALL logger_error( & 
    1106             &  "  DIM REORDER 2 XYZT: you should have run dim_reorder & 
    1107             &     before running REORDER" ) 
     1132            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//& 
     1133            &  "   before running REORDER" ) 
    11081134 
    11091135         ENDIF         
    … …  
    11161142   END FUNCTION dim__reorder_2xyzt_i4 
    11171143   !------------------------------------------------------------------- 
    1118    !> @brief This function unordered integer(4) 1D array to be suitable with 
     1144   !> @brief This function disordered integer(4) 1D array to be suitable with 
    11191145   !> initial dimension order (ex: dimension read in file). 
    11201146   !> @note you must have run dim_reorder before use this subroutine 
    … …  
    11431169      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 
    11441170      &   SIZE(id_arr(:)) /= ip_maxdim )THEN 
    1145          CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//& 
    1146          &              " or of array of value.") 
     1171         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//& 
     1172            &  "array dimension or of array of value.") 
    11471173      ELSE       
    11481174         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 
    11491175 
    11501176            CALL logger_error( & 
    1151             &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
    1152             &     before running REORDER" ) 
     1177            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// & 
     1178            &  "   before running REORDER" ) 
    11531179 
    11541180         ENDIF         
    … …  
    11661192   ! 
    11671193   !> @author J.Paul 
    1168    !> @date Nov, 2013 - Initial Version 
     1194   !> @date November, 2013 - Initial Version 
    11691195   ! 
    11701196   !> @param[in] td_dim array of dimension structure 
    … …  
    11931219 
    11941220            CALL logger_error( & 
    1195             &  "  DIM REORDER 2 XYZT: you should have run dim_reorder & 
    1196             &     before running REORDER" ) 
     1221            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// & 
     1222            &  "   before running REORDER" ) 
    11971223 
    11981224         ENDIF         
    … …  
    12051231   END FUNCTION dim__reorder_2xyzt_l 
    12061232   !------------------------------------------------------------------- 
    1207    !> @brief This function unordered logical 1D array to be suitable with 
     1233   !> @brief This function disordered logical 1D array to be suitable with 
    12081234   !> initial dimension order (ex: dimension read in file). 
    12091235   !> @note you must have run dim_reorder before use this subroutine 
    … …  
    12381264 
    12391265            CALL logger_error( & 
    1240             &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
    1241             &     before running REORDER" ) 
     1266            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//& 
     1267            &  "  before running REORDER" ) 
    12421268 
    12431269         ENDIF         
    … …  
    12941320   END FUNCTION dim__reorder_2xyzt_c 
    12951321   !------------------------------------------------------------------- 
    1296    !> @brief This function unordered string 1D array to be suitable with 
     1322   !> @brief This function disordered string 1D array to be suitable with 
    12971323   !> initial dimension order (ex: dimension read in file). 
    12981324   !> @note you must have run dim_reorder before use this subroutine 
    12991325   ! 
    13001326   !> @author J.Paul 
    1301    !> @date Nov, 2013 - Initial Version 
     1327   !> @date November, 2013 - Initial Version 
    13021328   ! 
    13031329   !> @param[in] td_dim array of dimension structure 
    … …  
    13261352         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 
    13271353            CALL logger_error( & 
    1328             &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
    1329             &     before running REORDER" ) 
     1354            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// & 
     1355            &  "   before running REORDER" ) 
    13301356 
    13311357         ENDIF         
    … …  
    13831409 
    13841410   END SUBROUTINE dim__clean_arr 
     1411   !------------------------------------------------------------------- 
     1412   !> @brief This subroutine fill dummy dimension array 
     1413   ! 
     1414   !> @author J.Paul 
     1415   !> @date September, 2015 - Initial Version 
     1416   ! 
     1417   !> @param[in] cd_dummy dummy configuration file 
     1418   !------------------------------------------------------------------- 
     1419   SUBROUTINE dim_get_dummy( cd_dummy ) 
     1420      IMPLICIT NONE 
     1421      ! Argument 
     1422      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy 
     1423 
     1424      ! local variable 
     1425      INTEGER(i4)   :: il_fileid 
     1426      INTEGER(i4)   :: il_status 
     1427 
     1428      LOGICAL       :: ll_exist 
     1429 
     1430      ! loop indices 
     1431      ! 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 
     1435 
     1436      !---------------------------------------------------------------- 
     1437      NAMELIST /namdum/ &   !< dummy namelist 
     1438      &  cn_dumvar, &       !< variable  name 
     1439      &  cn_dumdim, &       !< dimension name 
     1440      &  cn_dumatt          !< attribute name 
     1441      !---------------------------------------------------------------- 
     1442 
     1443      ! init 
     1444      cm_dumdim(:)='' 
     1445 
     1446      ! read namelist 
     1447      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 
     1448      IF( ll_exist )THEN 
     1449 
     1450         il_fileid=fct_getunit() 
     1451 
     1452         OPEN( il_fileid, FILE=TRIM(cd_dummy), & 
     1453         &                FORM='FORMATTED',       & 
     1454         &                ACCESS='SEQUENTIAL',    & 
     1455         &                STATUS='OLD',           & 
     1456         &                ACTION='READ',          & 
     1457         &                IOSTAT=il_status) 
     1458         CALL fct_err(il_status) 
     1459         IF( il_status /= 0 )THEN 
     1460            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 
     1461         ENDIF 
     1462 
     1463         READ( il_fileid, NML = namdum ) 
     1464         cm_dumdim(:)=cn_dumdim(:) 
     1465 
     1466         CLOSE( il_fileid ) 
     1467 
     1468      ENDIF 
     1469 
     1470   END SUBROUTINE dim_get_dummy 
     1471   !------------------------------------------------------------------- 
     1472   !> @brief This function check if dimension is defined as dummy dimension 
     1473   !> in configuraton file 
     1474   !> 
     1475   !> @author J.Paul 
     1476   !> @date September, 2015 - Initial Version 
     1477   ! 
     1478   !> @param[in] td_dim dimension structure 
     1479   !> @return true if dimension is dummy dimension  
     1480   !------------------------------------------------------------------- 
     1481   FUNCTION dim_is_dummy(td_dim) 
     1482      IMPLICIT NONE 
     1483 
     1484      ! Argument       
     1485      TYPE(TDIM), INTENT(IN) :: td_dim 
     1486       
     1487      ! function 
     1488      LOGICAL :: dim_is_dummy 
     1489       
     1490      ! loop indices 
     1491      INTEGER(i4) :: ji 
     1492      !---------------------------------------------------------------- 
     1493 
     1494      dim_is_dummy=.FALSE. 
     1495      DO ji=1,ip_maxdum 
     1496         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN 
     1497            dim_is_dummy=.TRUE. 
     1498            EXIT 
     1499         ENDIF 
     1500      ENDDO 
     1501 
     1502   END FUNCTION dim_is_dummy 
    13851503END MODULE dim 
    13861504 
Note: See TracChangeset for help on using the changeset viewer.