Changeset 9987 for branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90
- Timestamp:
- 2018-07-23T11:33:03+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/TOOLS/SIREN/src/iom_mpp.f90
r5037 r9987 87 87 !> J.Paul 88 88 ! REVISION HISTORY: 89 !> @date Nov , 2013 - Initial Version89 !> @date November, 2013 - Initial Version 90 90 !> 91 91 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 137 137 !> 138 138 !> @author J.Paul 139 !> - November, 2013- Initial Version139 !> @date November, 2013 - Initial Version 140 140 ! 141 141 !> @param[inout] td_mpp mpp structure … … 161 161 162 162 ELSE 163 ! 164 td_mpp%i_id=1 165 163 166 ! if no processor file selected 164 167 ! force to open all files … … 221 224 !> 222 225 !> @author J.Paul 223 !> - November, 2013- Initial Version226 !> @date November, 2013 - Initial Version 224 227 ! 225 228 !> @param[inout] td_mpp mpp structure … … 248 251 !> 249 252 !> @author J.Paul 250 !> - November, 2013- Initial Version253 !> @date November, 2013 - Initial Version 251 254 ! 252 255 !> @param[in] td_mpp mpp structure … … 267 270 268 271 ELSE 272 ! 273 td_mpp%i_id=0 274 269 275 DO ji=1,td_mpp%i_nproc 270 276 IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN … … 285 291 !> 286 292 !> @author J.Paul 287 !> - November, 2013- Initial Version293 !> @date November, 2013 - Initial Version 288 294 !> @date October, 2014 289 295 !> - use start and count array instead of domain structure. … … 314 320 & " in mpp strcuture "//TRIM(td_mpp%c_name)) 315 321 322 ELSEIF( td_mpp%i_id == 0 )THEN 323 324 CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//& 325 & " can not read variable in "//TRIM(td_mpp%c_name)) 326 316 327 ELSE 328 317 329 318 330 IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN … … 355 367 ! 356 368 !> @author J.Paul 357 !> - November, 2013- Initial Version369 !> @date November, 2013 - Initial Version 358 370 !> @date October, 2014 359 371 !> - use start and count array instead of domain structure. … … 384 396 & " in mpp strcuture "//TRIM(td_mpp%c_name)) 385 397 398 ELSEIF( td_mpp%i_id == 0 )THEN 399 400 CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//& 401 & " can not read variable in "//TRIM(td_mpp%c_name)) 402 386 403 ELSE 387 404 … … 400 417 CALL logger_error( & 401 418 & " IOM MPP READ VAR: there is no variable with "//& 402 & "name or standard name "//TRIM(cd_name)//&419 & "name or standard name "//TRIM(cd_name)//& 403 420 & " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name)) 404 421 ENDIF … … 416 433 ! 417 434 !> @author J.Paul 418 !> - November, 2013- Initial Version435 !> @date November, 2013 - Initial Version 419 436 !> @date October, 2014 420 437 !> - use start and count array instead of domain structure. … … 467 484 IF( PRESENT(id_count) ) il_count(:)=id_count(:) 468 485 486 CALL logger_debug("IOM MPP READ VAR VALUE: start "//& 487 & TRIM(fct_str(il_start(jp_I)))//","//& 488 & TRIM(fct_str(il_start(jp_J)))//","//& 489 & TRIM(fct_str(il_start(jp_K)))//","//& 490 & TRIM(fct_str(il_start(jp_L))) ) 491 CALL logger_debug("IOM MPP READ VAR VALUE: count "//& 492 & TRIM(fct_str(il_count(jp_I)))//","//& 493 & TRIM(fct_str(il_count(jp_J)))//","//& 494 & TRIM(fct_str(il_count(jp_K)))//","//& 495 & TRIM(fct_str(il_count(jp_L))) ) 496 469 497 DO jk=1,ip_maxdim 470 498 IF( .NOT. td_var%t_dim(jk)%l_use )THEN … … 476 504 ENDDO 477 505 478 479 506 IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN 507 CALL logger_debug("IOM MPP READ VAR VALUE: start + count "//& 508 & TRIM(fct_str(il_end(jp_I)))//","//& 509 & TRIM(fct_str(il_end(jp_J)))//","//& 510 & TRIM(fct_str(il_end(jp_K)))//","//& 511 & TRIM(fct_str(il_end(jp_L))) ) 512 CALL logger_debug("IOM MPP READ VAR VALUE: dimension "//& 513 & TRIM(fct_str(td_mpp%t_dim(jp_I)%i_len))//","//& 514 & TRIM(fct_str(td_mpp%t_dim(jp_J)%i_len))//","//& 515 & TRIM(fct_str(td_mpp%t_dim(jp_K)%i_len))//","//& 516 & TRIM(fct_str(td_mpp%t_dim(jp_L)%i_len)) ) 480 517 CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//& 481 518 & "exceed dimension bound.") … … 583 620 ! 584 621 !> @details 622 !> optionally, you could specify the dimension order (default 'xyzt') 585 623 ! 586 624 !> @author J.Paul 587 !> - November, 2013- Initial Version 625 !> @date November, 2013 - Initial Version 626 !> @date July, 2015 - add dimension order option 588 627 ! 589 628 !> @param[inout] td_mpp mpp structure 590 !------------------------------------------------------------------- 591 SUBROUTINE iom_mpp_write_file(td_mpp) 629 !> @param[In] cd_dimorder dimension order 630 !------------------------------------------------------------------- 631 SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder) 592 632 IMPLICIT NONE 593 633 ! Argument 594 TYPE(TMPP), INTENT(INOUT) :: td_mpp 634 TYPE(TMPP) , INTENT(INOUT) :: td_mpp 635 CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: cd_dimorder 595 636 596 637 ! local variable … … 610 651 !CALL file_del_att(td_mpp%t_proc(ji), 'ew_overlap') 611 652 612 CALL iom_write_file(td_mpp%t_proc(ji) )653 CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder) 613 654 ELSE 614 655 CALL logger_debug( " MPP WRITE: no id associated to file "//&
Note: See TracChangeset
for help on using the changeset viewer.