- Timestamp:
- 2015-11-27T17:35:41+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_Surge_Modelling/NEMOGCM/TOOLS/SIREN/src/mpp.f90
r5037 r5942 165 165 !> to get processors to be used:<br/> 166 166 !> @code 167 !> CALL mpp_get_use( td_mpp, id_imin, id_imax, id_idim,&168 !> & id_jmin, id_jmax , id_jdim)167 !> CALL mpp_get_use( td_mpp, id_imin, id_imax, & 168 !> & id_jmin, id_jmax ) 169 169 !> @endcode 170 170 !> - id_imin 171 171 !> - id_imax 172 !> - id_idim173 172 !> - id_jmin 174 173 !> - id_jmax 175 !> - id_jdim176 174 !> 177 175 !> to get sub domains which form global domain contour:<br/> … … 352 350 !> 353 351 !> @author J.Paul 354 !> - November, 2013- Initial Version352 !> @date November, 2013 - Initial Version 355 353 !> @date November, 2014 356 354 !> - use function instead of overload assignment operator … … 379 377 ! copy mpp variable 380 378 mpp__copy_unit%c_name = TRIM(td_mpp%c_name) 379 mpp__copy_unit%i_id = td_mpp%i_id 381 380 mpp__copy_unit%i_niproc = td_mpp%i_niproc 382 381 mpp__copy_unit%i_njproc = td_mpp%i_njproc … … 425 424 !> 426 425 !> @author J.Paul 427 !> - November, 2013- Initial Version426 !> @date November, 2013 - Initial Version 428 427 !> @date November, 2014 429 428 !> - use function instead of overload assignment operator … … 454 453 ! 455 454 !> @author J.Paul 456 !> - Nov, 2013- Initial Version455 !> @date November, 2013 - Initial Version 457 456 ! 458 457 !> @param[in] td_mpp mpp structure … … 495 494 ! print dimension 496 495 IF( td_mpp%i_ndim /= 0 )THEN 497 WRITE(*,'(/a)') " Filedimension"496 WRITE(*,'(/a)') " MPP dimension" 498 497 DO ji=1,ip_maxdim 499 498 IF( td_mpp%t_dim(ji)%l_use )THEN … … 698 697 CALL dim_clean(tl_dim) 699 698 700 IF( ( PRESENT(id_niproc) .AND. (.NOT. PRESENT(id_n iproc))) .OR. &699 IF( ( PRESENT(id_niproc) .AND. (.NOT. PRESENT(id_njproc))) .OR. & 701 700 ((.NOT. PRESENT(id_niproc)) .AND. PRESENT(id_njproc) ) )THEN 702 701 CALL logger_warn( "MPP INIT: number of processors following I and J "//& … … 912 911 !> 913 912 !> @author J.Paul 914 !> - November, 2013- Initial Version913 !> @date November, 2013 - Initial Version 915 914 ! 916 915 !> @param[in] td_file file strcuture … … 1028 1027 ! create some attributes for domain decomposition (use with dimg file) 1029 1028 tl_att=att_init( "DOMAIN_number_total", mpp__init_file%i_nproc ) 1030 CALL mpp_ add_att(mpp__init_file, tl_att)1029 CALL mpp_move_att(mpp__init_file, tl_att) 1031 1030 1032 1031 tl_att=att_init( "DOMAIN_I_position_first", mpp__init_file%t_proc(:)%i_impp ) 1033 CALL mpp_ add_att(mpp__init_file, tl_att)1032 CALL mpp_move_att(mpp__init_file, tl_att) 1034 1033 1035 1034 tl_att=att_init( "DOMAIN_J_position_first", mpp__init_file%t_proc(:)%i_jmpp ) 1036 CALL mpp_ add_att(mpp__init_file, tl_att)1035 CALL mpp_move_att(mpp__init_file, tl_att) 1037 1036 1038 1037 tl_att=att_init( "DOMAIN_I_position_last", mpp__init_file%t_proc(:)%i_lci ) 1039 CALL mpp_ add_att(mpp__init_file, tl_att)1038 CALL mpp_move_att(mpp__init_file, tl_att) 1040 1039 1041 1040 tl_att=att_init( "DOMAIN_J_position_last", mpp__init_file%t_proc(:)%i_lcj ) 1042 CALL mpp_ add_att(mpp__init_file, tl_att)1041 CALL mpp_move_att(mpp__init_file, tl_att) 1043 1042 1044 1043 tl_att=att_init( "DOMAIN_I_halo_size_start", mpp__init_file%t_proc(:)%i_ldi ) 1045 CALL mpp_ add_att(mpp__init_file, tl_att)1044 CALL mpp_move_att(mpp__init_file, tl_att) 1046 1045 1047 1046 tl_att=att_init( "DOMAIN_J_halo_size_start", mpp__init_file%t_proc(:)%i_ldj ) 1048 CALL mpp_ add_att(mpp__init_file, tl_att)1047 CALL mpp_move_att(mpp__init_file, tl_att) 1049 1048 1050 1049 tl_att=att_init( "DOMAIN_I_halo_size_end", mpp__init_file%t_proc(:)%i_lei ) 1051 CALL mpp_ add_att(mpp__init_file, tl_att)1050 CALL mpp_move_att(mpp__init_file, tl_att) 1052 1051 1053 1052 tl_att=att_init( "DOMAIN_J_halo_size_end", mpp__init_file%t_proc(:)%i_lej ) 1054 CALL mpp_ add_att(mpp__init_file, tl_att)1053 CALL mpp_move_att(mpp__init_file, tl_att) 1055 1054 1056 1055 ! clean … … 1122 1121 CALL file_clean(tl_file) 1123 1122 1124 CALL logger_debug("MPP INIT READ: fin init_read ")1125 1123 END FUNCTION mpp__init_file 1126 1124 !------------------------------------------------------------------- … … 1131 1129 ! 1132 1130 !> @author J.Paul 1133 !> - November, 2013- Initial Version 1131 !> @date November, 2013 - Initial Version 1132 !> @date July, 2015 - add only use dimension in MPP structure 1134 1133 !> 1135 1134 !> @param[in] td_file file strcuture … … 1163 1162 IF( td_file%i_id == 0 )THEN 1164 1163 CALL logger_info(" id "//TRIM(fct_str(td_file%i_id))) 1165 CALL logger_error("MPP INIT READ: netcdf file "// TRIM(td_file%c_name)//&1166 &" not opened")1164 CALL logger_error("MPP INIT READ: netcdf file "//& 1165 & TRIM(td_file%c_name)//" not opened") 1167 1166 ELSE 1168 1167 … … 1191 1190 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1192 1191 ENDIF 1193 tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len) 1194 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1195 1196 tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len) 1197 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1192 1193 IF( td_file%t_dim(3)%l_use )THEN 1194 tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len) 1195 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1196 ENDIF 1197 1198 IF( td_file%t_dim(4)%l_use )THEN 1199 tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len) 1200 CALL mpp_add_dim(mpp__init_file_cdf,tl_dim) 1201 ENDIF 1198 1202 1199 1203 ! initialise file/processor … … 1312 1316 ! 1313 1317 !> @author J.Paul 1314 !> - November, 2013- Initial Version1318 !> @date November, 2013 - Initial Version 1315 1319 ! 1316 1320 !> @param[in] td_file file strcuture … … 1532 1536 ! 1533 1537 !> @author J.Paul 1534 !> - Nov, 2013- Initial Version1538 !> @date November, 2013 - Initial Version 1535 1539 ! 1536 1540 !> @param[in] td_mpp mpp structure … … 1624 1628 IF( il_varid /= 0 )THEN 1625 1629 1626 CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//&1627 & ", standard name "//TRIM(td_var%c_stdname)//&1628 & ", already in mpp "//TRIM(td_mpp%c_name) )1629 1630 1630 DO ji=1,td_mpp%t_proc(1)%i_nvar 1631 1631 CALL logger_debug( " MPP ADD VAR: in mpp structure : & … … 1634 1634 & TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) ) 1635 1635 ENDDO 1636 CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//& 1637 & ", standard name "//TRIM(td_var%c_stdname)//& 1638 & ", already in mpp "//TRIM(td_mpp%c_name) ) 1636 1639 1637 1640 ELSE … … 1675 1678 ! 1676 1679 !> @author J.Paul 1677 !> - November, 2013- Initial Version1680 !> @date November, 2013 - Initial Version 1678 1681 ! 1679 1682 !> @param[in] td_mpp mpp structure … … 1840 1843 !> @author J.Paul 1841 1844 !> @date November, 2013 - Initial version 1845 !> @date February, 2015 1846 !> - define local variable structure to avoid mistake with pointer 1842 1847 ! 1843 1848 !> @param[inout] td_mpp mpp strcuture … … 1852 1857 ! local variable 1853 1858 INTEGER(i4) :: il_varid 1859 TYPE(TVAR) :: tl_var 1854 1860 !---------------------------------------------------------------- 1855 1861 ! check if mpp exist … … 1882 1888 ELSE 1883 1889 1884 CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(il_varid)) 1890 tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid)) 1891 CALL mpp_del_var(td_mpp, tl_var) 1885 1892 1886 1893 ENDIF … … 2193 2200 !> 2194 2201 !> @author J.Paul 2195 !> - November, 2013- Initial Version 2202 !> @date November, 2013 - Initial Version 2203 !> @date July, 2015 2204 !> - rewrite the same as way var_add_dim 2196 2205 !> 2197 2206 !> @param[inout] td_mpp mpp structure … … 2208 2217 2209 2218 ! loop indices 2210 INTEGER(i4) :: ji2211 2219 !---------------------------------------------------------------- 2212 2220 IF( td_mpp%i_ndim <= ip_maxdim )THEN 2213 2221 2214 ! check if dimension already in mpp structure 2215 il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname) 2216 IF( il_ind /= 0 )THEN 2217 2218 IF( td_mpp%t_dim(il_ind)%l_use )THEN 2219 CALL logger_error( & 2220 & "MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 2221 & ", short name "//TRIM(td_dim%c_sname)//& 2222 & ", already used in mpp "//TRIM(td_mpp%c_name) ) 2223 ELSE 2224 ! replace dimension 2225 td_mpp%t_dim(il_ind)=dim_copy(td_dim) 2226 td_mpp%t_dim(il_ind)%i_id=il_ind 2227 td_mpp%t_dim(il_ind)%l_use=.TRUE. 2228 ENDIF 2229 2222 ! check if dimension already used in mpp structure 2223 il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 2224 IF( il_ind == 0 )THEN 2225 CALL logger_warn( & 2226 & " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 2227 & ", short name "//TRIM(td_dim%c_sname)//& 2228 & ", will not be added in mpp "//TRIM(td_mpp%c_name) ) 2229 ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN 2230 CALL logger_error( & 2231 & " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//& 2232 & ", short name "//TRIM(td_dim%c_sname)//& 2233 & ", already used in mpp "//TRIM(td_mpp%c_name) ) 2230 2234 ELSE 2231 2235 2232 IF( td_mpp%i_ndim == ip_maxdim )THEN 2233 CALL logger_error( & 2234 & "MPP ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//& 2235 & ", short name "//TRIM(td_dim%c_sname)//& 2236 & ", in mpp "//TRIM(td_mpp%c_name)//". Already "//& 2237 & TRIM(fct_str(ip_maxdim))//" dimensions." ) 2238 ELSE 2239 ! search empty dimension 2240 DO ji=1,ip_maxdim 2241 IF( td_mpp%t_dim(ji)%i_id == 0 )THEN 2242 il_ind=ji 2243 EXIT 2244 ENDIF 2245 ENDDO 2246 2247 ! add new dimension 2248 td_mpp%t_dim(il_ind)=dim_copy(td_dim) 2249 ! update number of attribute 2250 td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 2251 2252 td_mpp%t_dim(il_ind)%l_use=.TRUE. 2253 td_mpp%t_dim(il_ind)%i_id=td_mpp%i_ndim 2254 ENDIF 2236 ! back to disorder dimension array 2237 CALL dim_disorder(td_mpp%t_dim(:)) 2238 2239 ! add new dimension 2240 td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim) 2241 2242 ! update number of attribute 2243 td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 2255 2244 2256 2245 ENDIF 2246 ! reorder dimension to ('x','y','z','t') 2247 CALL dim_reorder(td_mpp%t_dim(:)) 2257 2248 2258 2249 ELSE … … 2268 2259 !> 2269 2260 !> @author J.Paul 2270 !> - November, 2013- Initial Version 2261 !> @date November, 2013 - Initial Version 2262 !> @date July, 2015 2263 !> - rewrite the same as way var_del_dim 2271 2264 !> 2272 2265 !> @param[inout] td_mpp mpp structure … … 2280 2273 2281 2274 ! local variable 2282 INTEGER(i4) :: il_status2283 2275 INTEGER(i4) :: il_ind 2284 TYPE(TDIM) , DIMENSION(:), ALLOCATABLE:: tl_dim2276 TYPE(TDIM) :: tl_dim 2285 2277 2286 2278 ! loop indices 2287 INTEGER(i4) :: ji 2288 !---------------------------------------------------------------- 2289 ! check if dimension already in mpp structure 2290 il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname) 2291 IF( il_ind == 0 )THEN 2292 2293 CALL logger_error( & 2294 & "MPP DEL DIM: no dimension "//TRIM(td_dim%c_name)//& 2279 !---------------------------------------------------------------- 2280 2281 2282 IF( td_mpp%i_ndim <= ip_maxdim )THEN 2283 2284 CALL logger_trace( & 2285 & " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//& 2295 2286 & ", short name "//TRIM(td_dim%c_sname)//& 2296 2287 & ", in mpp "//TRIM(td_mpp%c_name) ) 2288 2289 ! check if dimension already in variable structure 2290 il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname)) 2291 2292 ! replace dimension by empty one 2293 td_mpp%t_dim(il_ind)=dim_copy(tl_dim) 2294 2295 ! update number of dimension 2296 td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use) 2297 2298 ! reorder dimension to ('x','y','z','t') 2299 CALL dim_reorder(td_mpp%t_dim) 2297 2300 2298 2301 ELSE 2299 2300 ALLOCATE( tl_dim(td_mpp%i_ndim-1), stat=il_status ) 2301 IF(il_status /= 0 )THEN 2302 2303 CALL logger_error( & 2304 & "MPP DEL DIM: not enough space to put dimensions from "//& 2305 & TRIM(td_mpp%c_name)//" in temporary dimension structure") 2306 2307 ELSE 2308 2309 ! save temporary dimension's mpp structure 2310 tl_dim( 1 : il_ind-1 ) = dim_copy(td_mpp%t_dim( 1 : il_ind-1 )) 2311 tl_dim( il_ind : td_mpp%i_ndim-1 ) = & 2312 & dim_copy(td_mpp%t_dim( il_ind+1 : td_mpp%i_ndim )) 2313 2314 ! remove dimension from file 2315 CALL dim_clean(td_mpp%t_dim(:)) 2316 ! copy dimension in file, except one 2317 td_mpp%t_dim(1:td_mpp%i_ndim)=dim_copy(tl_dim(:)) 2318 2319 ! update number of dimension 2320 td_mpp%i_ndim=td_mpp%i_ndim-1 2321 2322 ! update dimension id 2323 DO ji=1,td_mpp%i_ndim 2324 td_mpp%t_dim(ji)%i_id=ji 2325 ENDDO 2326 2327 ! clean 2328 CALL dim_clean(tl_dim(:)) 2329 DEALLOCATE(tl_dim) 2330 2331 ENDIF 2332 2302 CALL logger_error( & 2303 & " MPP DEL DIM: too much dimension in mpp "//& 2304 & TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")") 2333 2305 ENDIF 2334 2306 … … 2340 2312 !> 2341 2313 !> @author J.Paul 2342 !> - November, 2013- Initial Version2314 !> @date November, 2013 - Initial Version 2343 2315 !> 2344 2316 !> @param[inout] td_mpp mpp structure … … 2488 2460 & ", in mpp structure "//TRIM(td_mpp%c_name) ) 2489 2461 2490 IF( ASSOCIATED(td_mpp%t_proc(1)%t_ var) )THEN2462 IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN 2491 2463 DO ji=1,td_mpp%t_proc(1)%i_natt 2492 2464 CALL logger_debug( "MPP DEL ATT: in mpp structure : & 2493 & attribute : "//TRIM(td_mpp%t_proc(1)%t_ var(ji)%c_name) )2465 & attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) ) 2494 2466 ENDDO 2495 2467 ENDIF … … 2516 2488 !> @author J.Paul 2517 2489 !> @date November, 2013 - Initial version 2490 !> @date February, 2015 2491 !> - define local attribute structure to avoid mistake with pointer 2518 2492 ! 2519 2493 !> @param[inout] td_mpp mpp strcuture … … 2527 2501 2528 2502 ! local variable 2529 INTEGER(i4) :: il_attid 2503 INTEGER(i4) :: il_attid 2504 TYPE(TATT) :: tl_att 2530 2505 !---------------------------------------------------------------- 2531 2506 ! check if mpp exist … … 2551 2526 IF( il_attid == 0 )THEN 2552 2527 2553 CALL logger_ warn( &2528 CALL logger_debug( & 2554 2529 & "MPP DEL ATT : there is no attribute with "//& 2555 2530 & "name "//TRIM(cd_name)//" in mpp structure "//& … … 2558 2533 ELSE 2559 2534 2560 CALL mpp_del_att(td_mpp, td_mpp%t_proc(1)%t_att(il_attid)) 2535 tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid)) 2536 CALL mpp_del_att(td_mpp, tl_att) 2561 2537 2562 2538 ENDIF … … 2863 2839 2864 2840 CALL logger_info("MPP OPTIMIZ: number of processor "//& 2865 & TRIM(fct_str(tl_mpp%i_nproc)) ) 2841 & TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 2842 & TRIM(fct_str(tl_mpp%i_nproc)) ) 2866 2843 IF( tl_mpp%i_nproc > td_mpp%i_nproc .AND. & 2867 2844 & tl_mpp%i_nproc <= il_maxproc )THEN 2868 2845 ! save optimiz decomposition 2846 2847 CALL logger_info("MPP OPTIMIZ:save this decomposition "//& 2848 & TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//& 2849 & TRIM(fct_str(tl_mpp%i_nproc)) ) 2869 2850 2870 2851 ! clean mpp … … 3146 3127 !> 3147 3128 !> @author J.Paul 3148 !> @date November, 2013 3129 !> @date November, 2013 - Initial version 3149 3130 !> 3150 3131 !> @param[inout] td_mpp mpp strcuture … … 3184 3165 !> 3185 3166 !> @author J.Paul 3186 !> @date November, 2013 3167 !> @date November, 2013 - Initial version 3187 3168 !> 3188 3169 !> @param[in] td_mpp mpp strcuture … … 3249 3230 ! 3250 3231 !> @author J.Paul 3251 !> @date November, 2013 3232 !> @date November, 2013 - Initial version 3252 3233 ! 3253 3234 !> @param[in] td_mpp mpp strcuture … … 3311 3292 !> 3312 3293 !> @author J.Paul 3313 !> @date November, 2013 3294 !> @date November, 2013 - Initial version 3314 3295 !> 3315 3296 !> @param[inout] td_mpp mpp strcuture … … 3404 3385 !> 3405 3386 !> @author J.Paul 3406 !> - November, 2013- Initial Version3387 !> @date November, 2013 - Initial Version 3407 3388 !> 3408 3389 !> @param[in] td_mpp mpp structure … … 3417 3398 3418 3399 ! local variable 3419 INTEGER(i4) :: il_ndim3420 3400 3421 3401 ! loop indices … … 3429 3409 mpp__check_var_dim=.FALSE. 3430 3410 3431 CALL logger_error( &3432 & "MPP CHECK DIM: variable and mpp dimension differ"//&3433 & " for variable "//TRIM(td_var%c_name)//&3434 & " and mpp "//TRIM(td_mpp%c_name))3435 3436 3411 CALL logger_debug( & 3437 3412 & " mpp dimension: "//TRIM(fct_str(td_mpp%i_ndim))//& 3438 3413 & " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) ) 3439 il_ndim=MIN(td_var%i_ndim, td_mpp%i_ndim ) 3440 DO ji = 1, il_ndim 3414 DO ji = 1, ip_maxdim 3441 3415 CALL logger_debug( & 3442 3416 & "MPP CHECK DIM: for dimension "//& … … 3448 3422 & ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use))) 3449 3423 ENDDO 3424 3425 CALL logger_error( & 3426 & "MPP CHECK DIM: variable and mpp dimension differ"//& 3427 & " for variable "//TRIM(td_var%c_name)//& 3428 & " and mpp "//TRIM(td_mpp%c_name)) 3429 3450 3430 ENDIF 3451 3431 … … 3456 3436 ! 3457 3437 !> @author J.Paul 3458 !> - November, 2013- Initial Version3438 !> @date November, 2013 - Initial Version 3459 3439 ! 3460 3440 !> @param[in] td_file array of file structure … … 3496 3476 ! 3497 3477 !> @author J.Paul 3498 !> - Ocotber, 2014- Initial Version3478 !> @date Ocotber, 2014 - Initial Version 3499 3479 ! 3500 3480 !> @param[in] td_mpp mpp file structure
Note: See TracChangeset
for help on using the changeset viewer.