- Timestamp:
- 09/24/20 12:19:22 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
XIOS/dev/dev_ym/XIOS_COUPLING/src/test/generic_testcase.f90
r1936 r1942 33 33 CHARACTER(len_str) :: init_field2D="" 34 34 DOUBLE PRECISION :: pressure_factor 35 LOGICAL :: domain_mask 36 CHARACTER(len_str) :: domain_mask_type="cross" 35 LOGICAL :: domain_mask 36 CHARACTER(len_str) :: domain_mask_type="" 37 LOGICAL :: scalar_mask 38 CHARACTER(len_str) :: scalar_mask_type="" 37 39 LOGICAL :: axis_mask 38 40 LOGICAL :: mask3d … … 132 134 INTEGER, POINTER :: domain_index(:) 133 135 LOGICAL, POINTER :: axis_mask(:) 136 LOGICAL :: scalar_mask 134 137 INTEGER, POINTER :: axis_index(:) 135 138 DOUBLE PRECISION, POINTER :: ensemble_value(:) … … 151 154 152 155 DOUBLE PRECISION, POINTER :: field2D(:), other_field2D(:) 156 DOUBLE PRECISION :: field0D, other_field0D 153 157 DOUBLE PRECISION, POINTER :: field_X(:), other_field_X(:) 154 158 DOUBLE PRECISION, POINTER :: field_Y(:), other_field_Y(:) … … 166 170 167 171 DOUBLE PRECISION, POINTER :: field2D_W(:,:), other_field2D_W(:,:) 172 DOUBLE PRECISION, POINTER :: field0D_W(:), other_field0D_W(:) 168 173 DOUBLE PRECISION, POINTER :: field_XW(:,:), other_field_XW(:,:) 169 174 DOUBLE PRECISION, POINTER :: field_YW(:,:), other_field_YW(:,:) … … 190 195 INTEGER :: ierr 191 196 192 LOGICAL :: ok_field 2D, ok_field3D, ok_pressure, ok_field2D_sub, ok_field3D_sub,ok_field3D_recv, ok_field3D_send197 LOGICAL :: ok_field0D, ok_field2D, ok_field3D, ok_pressure, ok_field2D_sub, ok_field3D_sub,ok_field3D_recv, ok_field3D_send 193 198 LOGICAL :: ok_field_X, ok_field_Y, ok_field_XY, ok_field_Z, ok_field_XYZ, ok_field_XZ, ok_field_YZ 194 LOGICAL :: ok_field 2D_W, ok_field3D_W, ok_pressure_W, ok_field2D_sub_W, ok_field3D_sub_W,ok_field3D_recv_W, ok_field3D_send_W199 LOGICAL :: ok_field0D_W, ok_field2D_W, ok_field3D_W, ok_pressure_W, ok_field2D_sub_W, ok_field3D_sub_W,ok_field3D_recv_W, ok_field3D_send_W 195 200 LOGICAL :: ok_field_XW, ok_field_YW, ok_field_XYW, ok_field_ZW, ok_field_XYZW, ok_field_XZW, ok_field_YZW 196 201 197 LOGICAL :: ok_other_field 2D, ok_other_field3D, ok_other_pressure, ok_other_field2D_sub, ok_other_field3D_sub,ok_other_field3D_recv, ok_other_field3D_send202 LOGICAL :: ok_other_field0D, ok_other_field2D, ok_other_field3D, ok_other_pressure, ok_other_field2D_sub, ok_other_field3D_sub,ok_other_field3D_recv, ok_other_field3D_send 198 203 LOGICAL :: ok_other_field_X, ok_other_field_Y, ok_other_field_XY, ok_other_field_Z, ok_other_field_XYZ, ok_other_field_XZ, ok_other_field_YZ 199 LOGICAL :: ok_other_field 2D_W, ok_other_field3D_W, ok_other_pressure_W, ok_other_field2D_sub_W, ok_other_field3D_sub_W,ok_other_field3D_recv_W, ok_other_field3D_send_W204 LOGICAL :: ok_other_field0D_W, ok_other_field2D_W, ok_other_field3D_W, ok_other_pressure_W, ok_other_field2D_sub_W, ok_other_field3D_sub_W,ok_other_field3D_recv_W, ok_other_field3D_send_W 200 205 LOGICAL :: ok_other_field_XW, ok_other_field_YW, ok_other_field_XYW, ok_other_field_ZW, ok_other_field_XYZW, ok_other_field_XZW, ok_other_field_YZW 201 206 … … 235 240 236 241 CALL init_axis("axis", comm, params, axis_value, axis_mask, axis_index) 242 CALL init_scalar("scalar", comm, params, scalar_mask) 237 243 CALL init_ensemble("ensemble", comm, params, ensemble_value) 238 244 … … 311 317 ALLOCATE(field_XZW(0:x-1,0:z-1,0:w-1)) 312 318 ALLOCATE(field_YZW(0:y-1,0:z-1,0:w-1)) 319 ALLOCATE(field0D_W(0:w-1)) 313 320 314 321 … … 367 374 ENDDO 368 375 376 field0D=1 369 377 370 378 … … 379 387 field_XZW(:,:,0) = field_XZ(:,:)*(1+0.1*ensemble_value(0)) 380 388 field_YZW(:,:,0) = field_YZ(:,:)*(1+0.1*ensemble_value(0)) 381 389 field0D_W(0) = field0D*(1+0.1*ensemble_value(0)) 382 390 383 391 ok_field2D=xios_is_valid_field("field2D") ; … … 393 401 ok_field_XZ=xios_is_valid_field("field_XZ") ; 394 402 ok_field_YZ=xios_is_valid_field("field_YZ") ; 403 ok_field0D=xios_is_valid_field("field0D") ; 395 404 396 405 ok_field2D_W=xios_is_valid_field("field2D_W") ; … … 406 415 ok_field_XZW=xios_is_valid_field("field_XZW") ; 407 416 ok_field_YZW=xios_is_valid_field("field_YZW") ; 417 ok_field0D_W=xios_is_valid_field("field0D_W") ; 408 418 409 419 … … 440 450 441 451 CALL init_axis("other_axis", comm, other_params, axis_value, axis_mask, axis_index) 452 CALL init_scalar("other_scalar", comm, params, scalar_mask) 442 453 CALL init_ensemble("other_ensemble", comm, other_params, ensemble_value) 443 454 … … 516 527 ALLOCATE(other_field_XZW(0:x-1,0:z-1,0:w-1)) 517 528 ALLOCATE(other_field_YZW(0:y-1,0:z-1,0:w-1)) 529 ALLOCATE(other_field0D_W(0:w-1)) 518 530 519 531 … … 572 584 ENDDO 573 585 586 other_field0D = 1 574 587 575 588 … … 584 597 other_field_XZW(:,:,0) = other_field_XZ(:,:)*(1+0.1*ensemble_value(0)) 585 598 other_field_YZW(:,:,0) = other_field_YZ(:,:)*(1+0.1*ensemble_value(0)) 599 other_field0D_W(0) = other_field0D*(1+0.1*ensemble_value(0)) 586 600 587 601 … … 598 612 ok_other_field_XZ=xios_is_valid_field("other_field_XZ") ; 599 613 ok_other_field_YZ=xios_is_valid_field("other_field_YZ") ; 614 ok_other_field0D=xios_is_valid_field("other_field0D") ; 600 615 601 616 ok_other_field2D_W=xios_is_valid_field("other_field2D_W") ; … … 611 626 ok_other_field_XZW=xios_is_valid_field("other_field_XZW") ; 612 627 ok_other_field_YZW=xios_is_valid_field("other_field_YZW") ; 628 ok_other_field0D_W=xios_is_valid_field("other_field0D_W") ; 613 629 614 630 … … 636 652 IF (ok_field_XZ) CALL xios_send_field("field_XZ",field_XZ) 637 653 IF (ok_field_YZ) CALL xios_send_field("field_YZ",field_YZ) 654 IF (ok_field0D) CALL xios_send_field("field0D",field0D) 638 655 639 656 IF ( MOD(params%field_sub_offset+ts-1,params%field_sub_freq)==0) THEN … … 660 677 IF (ok_field_XZW) CALL xios_send_field("field_XZW",field_XZW) 661 678 IF (ok_field_YZW) CALL xios_send_field("field_YZW",field_YZW) 679 IF (ok_field0D_W) CALL xios_send_field("field0D_W",field0D_W) 662 680 663 681 IF ( MOD(params%field_sub_offset+ts-1,params%field_sub_freq)==0) THEN … … 675 693 field2D=field2D+1 676 694 field3D=field3D+1 695 field0D=field0D+1 677 696 678 697 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 691 710 IF (ok_other_field_XY) CALL xios_send_field("other_field_XZ", other_field_XZ) 692 711 IF (ok_other_field_XY) CALL xios_send_field("other_field_YZ", other_field_YZ) 712 IF (ok_other_field0D) CALL xios_send_field("other_field0D", other_field0D) 693 713 694 714 IF ( MOD(other_params%field_sub_offset+ts-1,other_params%field_sub_freq)==0) THEN … … 708 728 IF (ok_other_field3D_W) CALL xios_send_field("other_field3D_W",other_field3D_W) 709 729 IF (ok_other_pressure_W) CALL xios_send_field("other_pressure_W",other_pressure_W) 710 IF (ok_other_field_XW) CALL xios_send_field("other_field_XW",other_field_XW)711 IF (ok_other_field_YW) CALL xios_send_field("other_field_YW",other_field_YW)730 IF (ok_other_field_XW) CALL xios_send_field("other_field_XW",other_field_XW) 731 IF (ok_other_field_YW) CALL xios_send_field("other_field_YW",other_field_YW) 712 732 IF (ok_other_field_XYW) CALL xios_send_field("other_field_XYW",other_field_XYW) 713 IF (ok_other_field_ZW) CALL xios_send_field("other_field_ZW",other_field_ZW)733 IF (ok_other_field_ZW) CALL xios_send_field("other_field_ZW",other_field_ZW) 714 734 IF (ok_other_field_XYW) CALL xios_send_field("other_field_XYZW",other_field_XYZW) 715 735 IF (ok_other_field_XYW) CALL xios_send_field("other_field_XZW",other_field_XZW) 716 736 IF (ok_other_field_XYW) CALL xios_send_field("other_field_YZW",other_field_YZW) 737 IF (ok_other_field0D_W) CALL xios_send_field("other_field0D_W",other_field0D_W) 717 738 718 739 IF ( MOD(other_params%field_sub_offset+ts-1,other_params%field_sub_freq)==0) THEN … … 730 751 other_field2D=other_field2D+1 731 752 other_field3D=other_field3D+1 753 other_field0D=other_field0D+1 732 754 733 755 … … 757 779 IF (.NOT. xios_getvar(prefix//"domain_mask", params%domain_mask) ) params%domain_mask=.FALSE. 758 780 IF (.NOT. xios_getvar(prefix//"domain_mask_type", params%domain_mask_type) ) params%domain_mask_type="cross" 781 IF (.NOT. xios_getvar(prefix//"scalar_mask", params%scalar_mask) ) params%scalar_mask=.FALSE. 782 IF (.NOT. xios_getvar(prefix//"scalar_mask_type", params%scalar_mask_type) ) params%scalar_mask_type="none" 759 783 IF (.NOT. xios_getvar(prefix//"axis", params%axis) ) params%axis="pressure" 760 784 IF (.NOT. xios_getvar(prefix//"axis_mask", params%axis_mask) ) params%axis_mask=.FALSE. … … 2078 2102 END SUBROUTINE set_axis_mask 2079 2103 2104 SUBROUTINE init_scalar(scalar_id, comm, params, return_mask) 2105 IMPLICIT NONE 2106 CHARACTER(LEN=*) :: scalar_id 2107 TYPE(tmodel_params) :: params 2108 INTEGER :: comm 2109 LOGICAL :: return_mask 2110 DOUBLE PRECISION :: value =10. 2111 2112 CALL set_scalar_mask(comm, params, return_mask) 2113 CALL xios_set_scalar_attr(scalar_id, value=value, mask=return_mask) 2114 2115 END SUBROUTINE init_scalar 2116 2117 SUBROUTINE set_scalar_mask(comm, params, mask) 2118 IMPLICIT NONE 2119 TYPE(tmodel_params) :: params 2120 INTEGER :: comm 2121 LOGICAL :: mask 2122 INTEGER :: ierr,rank 2123 2124 mask=.TRUE. 2125 IF (params%scalar_mask) THEN 2126 IF (params%scalar_mask_type=="none") THEN 2127 mask=.TRUE. 2128 ELSE IF (params%scalar_mask_type=="full") THEN 2129 mask=.FALSE. 2130 ELSE IF (params%scalar_mask_type=="root") THEN 2131 CALL MPI_COMM_RANK(comm,rank,ierr) 2132 mask = (rank==0) 2133 ELSE IF (params%scalar_mask_type=="sparse") THEN 2134 CALL MPI_COMM_RANK(comm,rank,ierr) 2135 mask = (MOD(rank,2)==0) 2136 ENDIF 2137 ENDIF 2138 2139 END SUBROUTINE set_scalar_mask 2140 2080 2141 SUBROUTINE init_field2D_academic(comm,params, lon, lat, mask, return_field, & 2081 2142 X_lon, X_lat, X_mask, return_fieldX, &
Note: See TracChangeset
for help on using the changeset viewer.