- Timestamp:
- 2018-10-29T11:44:36+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/dimension.f90
r5037 r10248 78 78 !> 79 79 !> 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/> 81 81 !> The dimension structure return will be:<br/> 82 82 !> tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/> … … 94 94 !> - cl_neworder : character(len=4) (example: 'yxzt') 95 95 !> 96 !> to switch dimension array from ordered dimension to unordered96 !> to switch dimension array from ordered dimension to disordered 97 97 !> dimension:<br/> 98 98 !> @code 99 !> CALL dim_ unorder(tl_dim(:))99 !> CALL dim_disorder(tl_dim(:)) 100 100 !> @endcode 101 101 !> … … 111 111 !> CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:)) 112 112 !> @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/> 116 116 !> @code 117 117 !> CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:)) … … 123 123 !> CALL dim_reorder_2xyzt(tl_dim(:), tab(:)) 124 124 !> @endcode 125 !> - tab must be a 1D array with 4 elements " unordered".125 !> - tab must be a 1D array with 4 elements "disordered". 126 126 !> It could be composed of character, integer(4), or logical 127 127 !> 128 !> to reorder a 1D array of 4 elements in " unordered" dimension:<br/>129 !> @code 130 !> CALL dim_reorder_ 2xyzt(tl_dim(:), tab(:))128 !> to reorder a 1D array of 4 elements in "disordered" dimension:<br/> 129 !> @code 130 !> CALL dim_reorder_xyzt2(tl_dim(:), tab(:)) 131 131 !> @endcode 132 132 !> - tab must be a 1D array with 4 elements "ordered". … … 173 173 PUBLIC :: dim_print !< print dimension information 174 174 PUBLIC :: dim_copy !< copy dimension structure 175 PUBLIC :: dim_reorder !< filled dimension structure to switch from unordered to ordered dimension176 PUBLIC :: dim_ unorder !< switch dimension array from ordered to unordered dimension175 PUBLIC :: dim_reorder !< filled dimension structure to switch from disordered to ordered dimension 176 PUBLIC :: dim_disorder !< switch dimension array from ordered to disordered dimension 177 177 PUBLIC :: dim_fill_unused !< filled dimension structure with unused dimension 178 178 PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t') … … 321 321 !> @author J.Paul 322 322 !> @date November, 2013 - Initial Version 323 !> @date September, 2014 - do not check if dimension used 323 !> @date September, 2014 324 !> - do not check if dimension used 324 325 !> 325 326 !> @param[in] td_dim array of dimension structure … … 502 503 !> Optionally length could be inform, as well as short name and if dimension 503 504 !> is unlimited or not.<br/> 504 !> define dimension is supposed to be used. 505 !> 506 !> @author J.Paul 507 !> @date November, 2013 - Initial Version 505 !> By default, define dimension is supposed to be used. 506 !> Optionally you could force a defined dimension to be unused. 507 !> 508 !> @author J.Paul 509 !> @date November, 2013 - Initial Version 510 !> @date February, 2015 511 !> - add optional argument to define dimension unused 512 !> @date July, 2015 513 !> - Bug fix: inform order to disorder table instead of disorder to order 514 !> table 508 515 ! 509 516 !> @param[in] cd_name dimension name … … 511 518 !> @param[in] ld_uld dimension unlimited 512 519 !> @param[in] cd_sname dimension short name 520 !> @param[in] ld_uld dimension use or not 513 521 !> @return dimension structure 514 522 !------------------------------------------------------------------- 515 TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname )523 TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use) 516 524 IMPLICIT NONE 517 525 … … 521 529 LOGICAL, INTENT(IN), OPTIONAL :: ld_uld 522 530 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname 531 LOGICAL, INTENT(IN), OPTIONAL :: ld_use 523 532 524 533 ! local variable … … 543 552 544 553 ! define dimension is supposed to be used 545 dim_init%l_use=.TRUE. 554 IF( PRESENT(ld_use) )THEN 555 dim_init%l_use=ld_use 556 ELSE 557 dim_init%l_use=.TRUE. 558 ENDIF 546 559 547 560 IF( PRESENT(cd_sname) )THEN … … 590 603 ENDIF 591 604 592 ! get dimension order er index593 dim_init%i_ 2xyzt=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))605 ! get dimension order indices 606 dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname)) 594 607 595 608 END FUNCTION dim_init … … 655 668 !> @author J.Paul 656 669 !> @date November, 2013 - Initial Version 670 !> @date July, 2015 671 !> - Bug fix: use order to disorder table (see dim_init) 657 672 !> 658 673 !> @param[in] td_dim array of dimension structure … … 686 701 ! search missing dimension 687 702 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 )703 ! search first empty dimension (see dim_init) 704 il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 ) 690 705 691 706 ! put missing dimension instead of empty one … … 693 708 ! update output structure 694 709 tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji)) 695 tl_dim(il_ind(1))%i_ 2xyzt=ji710 tl_dim(il_ind(1))%i_xyzt2=ji 696 711 tl_dim(il_ind(1))%i_len=1 697 712 tl_dim(il_ind(1))%l_use=.FALSE. … … 711 726 !> This subroutine switch element of an array (4 elts) of dimension 712 727 !> structure 713 !> from unordered dimension to ordered dimension <br/>728 !> from disordered dimension to ordered dimension <br/> 714 729 !> 715 730 !> @details … … 722 737 !> @author J.Paul 723 738 !> @date November, 2013 - Initial Version 724 !> @date September, 2014 - allow to choose ordered dimension to be output 739 !> @date September, 2014 740 !> - allow to choose ordered dimension to be output 725 741 !> 726 742 !> @param[inout] td_dim array of dimension structure … … 811 827 !------------------------------------------------------------------- 812 828 !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t') 813 !> to unordered dimension. <br/>829 !> to disordered dimension. <br/> 814 830 !> @details 815 831 !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/> … … 822 838 !> @param[inout] td_dim array of dimension structure 823 839 !------------------------------------------------------------------- 824 SUBROUTINE dim_ unorder(td_dim)840 SUBROUTINE dim_disorder(td_dim) 825 841 IMPLICIT NONE 826 842 ! Argument … … 835 851 836 852 IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 837 CALL logger_error("DIM UNORDER: invalid dimension of array dimension.")853 CALL logger_error("DIM DISORDER: invalid dimension of array dimension.") 838 854 ELSE 839 855 ! add dummy xyzt2 id to unused dimension … … 868 884 ENDIF 869 885 870 END SUBROUTINE dim_ unorder886 END SUBROUTINE dim_disorder 871 887 !------------------------------------------------------------------- 872 888 !> @brief This function reshape real(8) 4D array … … 908 924 909 925 IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 910 CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of array dimension.") 926 CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//& 927 & "array dimension.") 911 928 ELSE 912 929 … … 914 931 915 932 CALL logger_fatal( & 916 & " DIM RESHAPE 2 XYZT: you should have run dim_reorder &917 & before running RESHAPE" )933 & " DIM RESHAPE 2 XYZT: you should have run dim_reorder"// & 934 & " before running RESHAPE" ) 918 935 919 936 ENDIF … … 972 989 !------------------------------------------------------------------- 973 990 !> @brief This function reshape ordered real(8) 4D array with dimension 974 !> (/'x','y','z','t'/) to an " unordered" array.<br/>991 !> (/'x','y','z','t'/) to an "disordered" array.<br/> 975 992 !> @details 976 993 !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/) … … 1009 1026 1010 1027 IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 1011 CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of array dimension.") 1028 CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//& 1029 & "array dimension.") 1012 1030 ELSE 1013 1031 … … 1015 1033 1016 1034 CALL logger_fatal( & 1017 & " DIM RESHAPE XYZT 2: you should have run dim_reorder &1018 & before running RESHAPE" )1035 & " DIM RESHAPE XYZT 2: you should have run dim_reorder"// & 1036 & " before running RESHAPE" ) 1019 1037 1020 1038 ENDIF … … 1104 1122 1105 1123 CALL logger_error( & 1106 & " DIM REORDER 2 XYZT: you should have run dim_reorder 1107 & before running REORDER" )1124 & " DIM REORDER 2 XYZT: you should have run dim_reorder"//& 1125 & " before running REORDER" ) 1108 1126 1109 1127 ENDIF … … 1116 1134 END FUNCTION dim__reorder_2xyzt_i4 1117 1135 !------------------------------------------------------------------- 1118 !> @brief This function unordered integer(4) 1D array to be suitable with1136 !> @brief This function disordered integer(4) 1D array to be suitable with 1119 1137 !> initial dimension order (ex: dimension read in file). 1120 1138 !> @note you must have run dim_reorder before use this subroutine … … 1143 1161 IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 1144 1162 & 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.")1163 CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//& 1164 & "array dimension or of array of value.") 1147 1165 ELSE 1148 1166 IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 1149 1167 1150 1168 CALL logger_error( & 1151 & " DIM REORDER XYZT 2: you should have run dim_reorder &1152 & before running REORDER" )1169 & " DIM REORDER XYZT 2: you should have run dim_reorder"// & 1170 & " before running REORDER" ) 1153 1171 1154 1172 ENDIF … … 1166 1184 ! 1167 1185 !> @author J.Paul 1168 !> @date Nov , 2013 - Initial Version1186 !> @date November, 2013 - Initial Version 1169 1187 ! 1170 1188 !> @param[in] td_dim array of dimension structure … … 1193 1211 1194 1212 CALL logger_error( & 1195 & " DIM REORDER 2 XYZT: you should have run dim_reorder &1196 & before running REORDER" )1213 & " DIM REORDER 2 XYZT: you should have run dim_reorder"// & 1214 & " before running REORDER" ) 1197 1215 1198 1216 ENDIF … … 1205 1223 END FUNCTION dim__reorder_2xyzt_l 1206 1224 !------------------------------------------------------------------- 1207 !> @brief This function unordered logical 1D array to be suitable with1225 !> @brief This function disordered logical 1D array to be suitable with 1208 1226 !> initial dimension order (ex: dimension read in file). 1209 1227 !> @note you must have run dim_reorder before use this subroutine … … 1238 1256 1239 1257 CALL logger_error( & 1240 & " DIM REORDER XYZT 2: you should have run dim_reorder 1241 & 1258 & " DIM REORDER XYZT 2: you should have run dim_reorder"//& 1259 & " before running REORDER" ) 1242 1260 1243 1261 ENDIF … … 1294 1312 END FUNCTION dim__reorder_2xyzt_c 1295 1313 !------------------------------------------------------------------- 1296 !> @brief This function unordered string 1D array to be suitable with1314 !> @brief This function disordered string 1D array to be suitable with 1297 1315 !> initial dimension order (ex: dimension read in file). 1298 1316 !> @note you must have run dim_reorder before use this subroutine 1299 1317 ! 1300 1318 !> @author J.Paul 1301 !> @date Nov , 2013 - Initial Version1319 !> @date November, 2013 - Initial Version 1302 1320 ! 1303 1321 !> @param[in] td_dim array of dimension structure … … 1326 1344 IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 1327 1345 CALL logger_error( & 1328 & " DIM REORDER XYZT 2: you should have run dim_reorder &1329 & before running REORDER" )1346 & " DIM REORDER XYZT 2: you should have run dim_reorder"// & 1347 & " before running REORDER" ) 1330 1348 1331 1349 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.