- Timestamp:
- 2017-04-18T15:42:46+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7923 r7924 53 53 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag 54 54 #endif 55 INTEGER, PRIVATE, PARAMETER :: max_rst_fields = 85 ! maximum number of variables in a restart file 55 56 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 56 57 PUBLIC iom_getatt, iom_use, iom_context_finalize … … 62 63 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 63 64 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 65 PRIVATE set_active_rst_fields 64 66 # endif 65 67 … … 141 143 CALL set_scalar 142 144 143 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN145 IF( TRIM(cdname) == TRIM(cxios_context) .OR. TRIM(cdname) == TRIM(rxios_context)) THEN 144 146 CALL set_grid( "T", glamt, gphit ) 145 147 CALL set_grid( "U", glamu, gphiu ) … … 184 186 185 187 ! vertical grid definition 186 CALL iom_set_axis_attr( "deptht", gdept_1d )187 CALL iom_set_axis_attr( "depthu", gdept_1d )188 CALL iom_set_axis_attr( "depthv", gdept_1d )189 CALL iom_set_axis_attr( "depthw", gdepw_1d )188 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 189 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 190 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 191 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 190 192 191 193 ! Add vertical grid bounds … … 227 229 228 230 ! automatic definitions of some of the xml attributs 229 CALL set_xmlatt 231 IF( TRIM(cdname) == TRIM(rxios_context)) THEN 232 CALL set_active_rst_fields 233 ELSE 234 CALL set_xmlatt 235 ENDIF 230 236 231 237 CALL set_1point … … 241 247 242 248 #endif 243 249 244 250 END SUBROUTINE iom_init 245 251 252 SUBROUTINE set_active_rst_fields 253 !sets enabled = .TRUE. for each field in restart file 254 CHARACTER(len=30),DIMENSION(max_rst_fields) :: rst_fields 255 INTEGER :: i 256 257 rst_fields(:)="NO_NAME" 258 259 rst_fields(1)="rdt" 260 rst_fields(2)="rdttra1" 261 rst_fields(3)="un" 262 rst_fields(4)="ub" 263 rst_fields(5)="vn" 264 rst_fields(6)="vb" 265 rst_fields(7)="tn" 266 rst_fields(8)="tb" 267 rst_fields(9)="sn" 268 rst_fields(10)="sb" 269 rst_fields(11)="sshn" 270 rst_fields(12)="sshb" 271 rst_fields(13)="hdivn" 272 rst_fields(14)="hdivb" 273 rst_fields(15)="rhop" 274 rst_fields(16)="rotn" 275 rst_fields(17)="rotb" 276 rst_fields(18)="kt" 277 rst_fields(19)="ndastp" 278 rst_fields(20)="adatrj" 279 rst_fields(21)="utau_b" 280 rst_fields(22)="vtau_b" 281 rst_fields(23)="qns_b" 282 rst_fields(24)="emp_b" 283 rst_fields(25)="sfx_b" 284 rst_fields(26)="en" 285 rst_fields(27)="avt" 286 rst_fields(28)="avm" 287 rst_fields(29)="avmu" 288 rst_fields(30)="avmv" 289 rst_fields(31)="dissl" 290 rst_fields(32)="sbc_hc_b" 291 rst_fields(33)="sbc_sc_b" 292 rst_fields(34)="qsr_hc_b" 293 rst_fields(35)="gcx" 294 rst_fields(36)="gcxb" 295 rst_fields(37)="fraqsr_1lev" 296 rst_fields(38)="greenland_icesheet_mass" 297 rst_fields(39)="greenland_icesheet_timelapsed" 298 rst_fields(40)="greenland_icesheet_mass_roc" 299 rst_fields(41)="antarctica_icesheet_mass" 300 rst_fields(42)="antarctica_icesheet_timelapsed" 301 rst_fields(43)="antarctica_icesheet_mass_roc" 302 rst_fields(44)="rhd" 303 rst_fields(45)="frc_v" 304 rst_fields(46)="frc_t" 305 rst_fields(47)="frc_s" 306 rst_fields(48)="frc_wn_t" 307 rst_fields(49)="frc_wn_s" 308 rst_fields(50)="ssh_ini" 309 rst_fields(51)="e3t_ini" 310 rst_fields(52)="hc_loc_ini" 311 rst_fields(53)="sc_loc_ini" 312 rst_fields(54)="ssh_hc_loc_ini" 313 rst_fields(55)="ssh_sc_loc_ini" 314 rst_fields(56)="fse3t_b" 315 rst_fields(57)="fse3t_n" 316 rst_fields(58)="tilde_e3t_b" 317 rst_fields(59)="tilde_e3t_n" 318 rst_fields(60)="hdiv_lf" 319 rst_fields(61)="ub2_b" 320 rst_fields(62)="vb2_b" 321 rst_fields(63)="sshbb_e" 322 rst_fields(64)="ubb_e" 323 rst_fields(65)="vbb_e" 324 rst_fields(66)="sshb_e" 325 rst_fields(67)="ub_e" 326 rst_fields(68)="vb_e" 327 rst_fields(69)="fwf_isf_b" 328 rst_fields(70)="isf_sc_b" 329 rst_fields(71)="isf_hc_b" 330 rst_fields(72)="ssh_ibb" 331 rst_fields(73)="rnf_b" 332 rst_fields(74)="rnf_hc_b" 333 rst_fields(75)="rnf_sc_b" 334 rst_fields(76)="nn_fsbc" 335 rst_fields(77)="ssu_m" 336 rst_fields(78)="ssv_m" 337 rst_fields(79)="sst_m" 338 rst_fields(80)="sss_m" 339 rst_fields(81)="ssh_m" 340 rst_fields(82)="e3t_m" 341 rst_fields(83)="frq_m" 342 rst_fields(84)="avmb" 343 rst_fields(85)="avtb" 344 345 DO i = 1, max_rst_fields 346 IF( TRIM(rst_fields(i)) /= "NO_NAME") THEN 347 IF( iom_varid( numror, TRIM(rst_fields(i)), ldstop = .FALSE. ) > 0 ) THEN 348 IF ( xios_is_valid_field( TRIM(rst_fields(i)) ) ) & 349 & CALL xios_set_field_attr ( TRIM(rst_fields(i)), enabled = .TRUE. ) 350 ENDIF 351 ENDIF 352 END DO 353 354 END SUBROUTINE set_active_rst_fields 246 355 247 356 SUBROUTINE iom_swap( cdname ) … … 254 363 #if defined key_iomput 255 364 TYPE(xios_context) :: nemo_hdl 256 257 365 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 258 366 CALL xios_get_handle(TRIM(cdname),nemo_hdl) … … 378 486 icnt = icnt + 1 379 487 END DO 488 ELSE 489 lxios_sini = .TRUE. 380 490 ENDIF 381 491 IF( llwrt ) THEN … … 567 677 !! INTERFACE iom_get 568 678 !!---------------------------------------------------------------------- 569 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )679 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, lrxios ) 570 680 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 571 681 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 572 682 REAL(wp) , INTENT( out) :: pvar ! read field 573 683 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 684 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! use xios to read restart 574 685 ! 575 686 INTEGER :: idvar ! variable id … … 579 690 CHARACTER(LEN=100) :: clname ! file name 580 691 CHARACTER(LEN=1) :: cldmspc ! 581 ! 582 itime = 1 583 IF( PRESENT(ktime) ) itime = ktime 584 ! 585 clname = iom_file(kiomid)%name 586 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 587 ! 588 IF( kiomid > 0 ) THEN 589 idvar = iom_varid( kiomid, cdvar ) 590 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 591 idmspc = iom_file ( kiomid )%ndims( idvar ) 592 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 593 WRITE(cldmspc , fmt='(i1)') idmspc 594 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 595 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 596 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 597 SELECT CASE (iom_file(kiomid)%iolib) 598 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar, itime ) 599 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 600 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idvar, pvar ) 601 CASE DEFAULT 602 CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 603 END SELECT 604 ENDIF 605 ENDIF 692 LOGICAL :: lxios 693 ! 694 lxios = .FALSE. 695 IF( PRESENT(lrxios) ) lxios = lrxios 696 697 IF(.NOT.lxios) THEN ! read data using default library 698 itime = 1 699 IF( PRESENT(ktime) ) itime = ktime 700 ! 701 clname = iom_file(kiomid)%name 702 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 703 ! 704 IF( kiomid > 0 ) THEN 705 idvar = iom_varid( kiomid, cdvar ) 706 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 707 idmspc = iom_file ( kiomid )%ndims( idvar ) 708 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 709 WRITE(cldmspc , fmt='(i1)') idmspc 710 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 711 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 712 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 713 SELECT CASE (iom_file(kiomid)%iolib) 714 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar, itime ) 715 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 716 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idvar, pvar ) 717 CASE DEFAULT 718 CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 719 END SELECT 720 ENDIF 721 ENDIF 722 ELSE 723 #if defined key_iomput 724 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 725 CALL iom_swap( TRIM(rxios_context) ) 726 CALL xios_recv_field( trim(cdvar), pvar) 727 CALL iom_swap( TRIM(cxios_context) ) 728 #endif 729 ENDIF 606 730 END SUBROUTINE iom_g0d 607 731 608 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )732 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrxios ) 609 733 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 610 734 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 614 738 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 615 739 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 740 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS 616 741 ! 617 742 IF( kiomid > 0 ) THEN 618 743 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 619 & ktime=ktime, kstart=kstart, kcount=kcount ) 744 & ktime=ktime, kstart=kstart, kcount=kcount, & 745 & lrxios=lrxios ) 620 746 ENDIF 621 747 END SUBROUTINE iom_g1d 622 748 623 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr 749 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, lrxios) 624 750 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 625 751 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 633 759 ! called open_ocean_jstart to set the start 634 760 ! value for the 2nd dimension (netcdf only) 761 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS 635 762 ! 636 763 IF( kiomid > 0 ) THEN 637 764 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 638 765 & ktime=ktime, kstart=kstart, kcount=kcount, & 639 & lrowattr=lrowattr 766 & lrowattr=lrowattr, lrxios=lrxios) 640 767 ENDIF 641 768 END SUBROUTINE iom_g2d 642 769 643 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )770 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, lrxios ) 644 771 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 645 772 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 653 780 ! called open_ocean_jstart to set the start 654 781 ! value for the 2nd dimension (netcdf only) 782 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS 655 783 ! 656 784 IF( kiomid > 0 ) THEN 657 785 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 658 786 & ktime=ktime, kstart=kstart, kcount=kcount, & 659 & lrowattr=lrowattr )787 & lrowattr=lrowattr, lrxios=lrxios ) 660 788 ENDIF 661 789 END SUBROUTINE iom_g3d … … 665 793 & pv_r1d, pv_r2d, pv_r3d, & 666 794 & ktime , kstart, kcount, & 667 & lrowattr 795 & lrowattr, lrxios ) 668 796 !!----------------------------------------------------------------------- 669 797 !! *** ROUTINE iom_get_123d *** … … 686 814 ! called open_ocean_jstart to set the start 687 815 ! value for the 2nd dimension (netcdf only) 688 ! 816 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! use XIOS to read restart 817 ! 818 LOGICAL :: lxios 689 819 LOGICAL :: llnoov ! local definition to read overlap 690 820 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute … … 713 843 !--------------------------------------------------------------------- 714 844 ! 715 clname = iom_file(kiomid)%name ! esier to read 716 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 717 ! local definition of the domain ? 718 idom = kdom 719 ! do we read the overlap 720 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 721 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 722 ! check kcount and kstart optionals parameters... 723 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 724 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 725 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 845 lxios = .FALSE. 846 if(PRESENT(lrxios)) lxios = lrxios 847 idvar = iom_varid( kiomid, cdvar ) 848 IF(.NOT.lxios) THEN 849 clname = iom_file(kiomid)%name ! esier to read 850 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 851 ! local definition of the domain ? 852 idom = kdom 853 ! do we read the overlap 854 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 855 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 856 ! check kcount and kstart optionals parameters... 857 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 858 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 859 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 726 860 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 727 861 728 luse_jattr = .false. 729 IF( PRESENT(lrowattr) ) THEN 730 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 731 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 732 ENDIF 733 IF( luse_jattr ) THEN 734 SELECT CASE (iom_file(kiomid)%iolib) 735 CASE (jpioipsl, jprstdimg ) 736 CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)') 737 luse_jattr = .false. 738 CASE (jpnf90 ) 739 ! Ok 740 CASE DEFAULT 741 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 742 END SELECT 743 ENDIF 744 745 ! Search for the variable in the data base (eventually actualize data) 746 istop = nstop 747 idvar = iom_varid( kiomid, cdvar ) 748 ! 749 IF( idvar > 0 ) THEN 750 ! to write iom_file(kiomid)%dimsz in a shorter way ! 751 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 752 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 753 idmspc = inbdim ! number of spatial dimensions in the file 754 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 755 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 756 ! 757 ! update idom definition... 758 ! Identify the domain in case of jpdom_auto(glo/dta) definition 759 IF( idom == jpdom_autoglo_xy ) THEN 760 ll_depth_spec = .TRUE. 761 idom = jpdom_autoglo 762 ELSE 763 ll_depth_spec = .FALSE. 764 ENDIF 765 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 766 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 767 ELSE ; idom = jpdom_data 768 ENDIF 769 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 770 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 771 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 772 ENDIF 773 ! Identify the domain in case of jpdom_local definition 774 IF( idom == jpdom_local ) THEN 775 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 776 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 777 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 778 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 779 ENDIF 780 ENDIF 781 ! 782 ! check the consistency between input array and data rank in the file 783 ! 784 ! initializations 785 itime = 1 786 IF( PRESENT(ktime) ) itime = ktime 787 788 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 789 WRITE(clrankpv, fmt='(i1)') irankpv 790 WRITE(cldmspc , fmt='(i1)') idmspc 791 ! 792 IF( idmspc < irankpv ) THEN 793 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 862 luse_jattr = .false. 863 IF( PRESENT(lrowattr) ) THEN 864 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 865 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 866 ENDIF 867 IF( luse_jattr ) THEN 868 SELECT CASE (iom_file(kiomid)%iolib) 869 CASE (jpioipsl, jprstdimg ) 870 CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)') 871 luse_jattr = .false. 872 CASE (jpnf90 ) 873 ! Ok 874 CASE DEFAULT 875 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 876 END SELECT 877 ENDIF 878 879 ! Search for the variable in the data base (eventually actualize data) 880 istop = nstop 881 ! 882 IF( idvar > 0 ) THEN 883 ! to write iom_file(kiomid)%dimsz in a shorter way ! 884 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 885 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 886 idmspc = inbdim ! number of spatial dimensions in the file 887 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 888 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 889 ! 890 ! update idom definition... 891 ! Identify the domain in case of jpdom_auto(glo/dta) definition 892 IF( idom == jpdom_autoglo_xy ) THEN 893 ll_depth_spec = .TRUE. 894 idom = jpdom_autoglo 895 ELSE 896 ll_depth_spec = .FALSE. 897 ENDIF 898 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 899 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 900 ELSE ; idom = jpdom_data 901 ENDIF 902 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 903 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 904 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 905 ENDIF 906 ! Identify the domain in case of jpdom_local definition 907 IF( idom == jpdom_local ) THEN 908 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 909 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 910 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 911 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 912 ENDIF 913 ENDIF 914 ! 915 ! check the consistency between input array and data rank in the file 916 ! 917 ! initializations 918 itime = 1 919 IF( PRESENT(ktime) ) itime = ktime 920 921 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 922 WRITE(clrankpv, fmt='(i1)') irankpv 923 WRITE(cldmspc , fmt='(i1)') idmspc 924 ! 925 IF( idmspc < irankpv ) THEN 926 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 794 927 & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 795 ELSEIF( idmspc == irankpv ) THEN796 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) &928 ELSEIF( idmspc == irankpv ) THEN 929 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 797 930 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 798 ELSEIF( idmspc > irankpv ) THEN799 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN800 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , &931 ELSEIF( idmspc > irankpv ) THEN 932 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 933 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , & 801 934 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 802 935 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 803 idmspc = idmspc - 1804 ELSE805 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , &936 idmspc = idmspc - 1 937 ELSE 938 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 806 939 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 807 940 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 808 ENDIF809 ENDIF810 811 !812 ! definition of istart and icnt813 !814 icnt (:) = 1815 istart(:) = 1816 istart(idmspc+1) = itime817 818 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)819 ELSE820 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc)821 ELSE822 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array823 IF( idom == jpdom_data ) THEN824 jstartrow = 1825 IF( luse_jattr ) THEN826 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found827 jstartrow = MAX(1,jstartrow)828 ENDIF829 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below830 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below831 ENDIF832 ! we do not read the overlap -> we start to read at nldi, nldj941 ENDIF 942 ENDIF 943 944 ! 945 ! definition of istart and icnt 946 ! 947 icnt (:) = 1 948 istart(:) = 1 949 istart(idmspc+1) = itime 950 951 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 952 ELSE 953 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc) 954 ELSE 955 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 956 IF( idom == jpdom_data ) THEN 957 jstartrow = 1 958 IF( luse_jattr ) THEN 959 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 960 jstartrow = MAX(1,jstartrow) 961 ENDIF 962 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 963 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 964 ENDIF 965 ! we do not read the overlap -> we start to read at nldi, nldj 833 966 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 834 967 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 835 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)968 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 836 969 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 837 970 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 838 971 ! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 839 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)840 ELSE ; icnt(1:2) = (/ nlci , nlcj /)841 ENDIF842 IF( PRESENT(pv_r3d) ) THEN843 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta844 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3)845 ELSE ; icnt(3) = jpk846 ENDIF847 ENDIF848 ENDIF849 ENDIF850 ENDIF851 852 ! check that istart and icnt can be used with this file853 !-854 DO jl = 1, jpmax_dims855 itmp = istart(jl)+icnt(jl)-1856 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN857 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp858 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl)859 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )860 ENDIF861 END DO862 863 ! check that icnt matches the input array864 !-865 IF( idom == jpdom_unknown ) THEN866 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d)867 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d)868 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d)869 ctmp1 = 'd'870 ELSE871 IF( irankpv == 2 ) THEN972 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 973 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 974 ENDIF 975 IF( PRESENT(pv_r3d) ) THEN 976 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta 977 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3) 978 ELSE ; icnt(3) = jpk 979 ENDIF 980 ENDIF 981 ENDIF 982 ENDIF 983 ENDIF 984 985 ! check that istart and icnt can be used with this file 986 !- 987 DO jl = 1, jpmax_dims 988 itmp = istart(jl)+icnt(jl)-1 989 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 990 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 991 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 992 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 993 ENDIF 994 END DO 995 996 ! check that icnt matches the input array 997 !- 998 IF( idom == jpdom_unknown ) THEN 999 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) 1000 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d) 1001 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d) 1002 ctmp1 = 'd' 1003 ELSE 1004 IF( irankpv == 2 ) THEN 872 1005 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 873 1006 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 874 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)'875 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)'876 ENDIF877 ENDIF878 IF( irankpv == 3 ) THEN1007 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 1008 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1009 ENDIF 1010 ENDIF 1011 IF( irankpv == 3 ) THEN 879 1012 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 880 1013 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 881 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'882 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'883 ENDIF884 ENDIF885 ENDIF1014 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 1015 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 1016 ENDIF 1017 ENDIF 1018 ENDIF 886 1019 887 DO jl = 1, irankpv888 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)889 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )890 END DO891 892 ENDIF893 894 ! read the data895 !-896 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...897 !898 ! find the right index of the array to be read1020 DO jl = 1, irankpv 1021 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 1022 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) ) 1023 END DO 1024 1025 ENDIF 1026 1027 ! read the data 1028 !- 1029 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1030 ! 1031 ! find the right index of the array to be read 899 1032 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 900 1033 ! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 901 1034 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 902 1035 ! ENDIF 903 IF( llnoov ) THEN904 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej905 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)906 ENDIF907 ELSE908 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj909 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)910 ENDIF911 ENDIF1036 IF( llnoov ) THEN 1037 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1038 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1039 ENDIF 1040 ELSE 1041 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 1042 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1043 ENDIF 1044 ENDIF 912 1045 913 SELECT CASE (iom_file(kiomid)%iolib)914 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &915 & pv_r1d, pv_r2d, pv_r3d )916 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &917 & pv_r1d, pv_r2d, pv_r3d )918 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, &919 & pv_r1d, pv_r2d, pv_r3d )920 CASE DEFAULT921 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )922 END SELECT923 924 IF( istop == nstop ) THEN ! no additional errors until this point...925 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)1046 SELECT CASE (iom_file(kiomid)%iolib) 1047 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 1048 & pv_r1d, pv_r2d, pv_r3d ) 1049 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 1050 & pv_r1d, pv_r2d, pv_r3d ) 1051 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, & 1052 & pv_r1d, pv_r2d, pv_r3d ) 1053 CASE DEFAULT 1054 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 1055 END SELECT 1056 1057 IF( istop == nstop ) THEN ! no additional errors until this point... 1058 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 926 1059 927 !--- overlap areas and extra hallows (mpp) 928 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 929 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 930 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 931 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 932 IF( icnt(3) == jpk ) THEN 933 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 934 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 935 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 936 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 937 ENDIF 938 ENDIF 939 940 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 941 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 942 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 943 944 !--- Apply scale_factor and offset 945 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 946 zofs = iom_file(kiomid)%ofs(idvar) ! offset 947 IF( PRESENT(pv_r1d) ) THEN 948 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 949 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 950 ELSEIF( PRESENT(pv_r2d) ) THEN 1060 !--- overlap areas and extra hallows (mpp) 1061 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1062 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 1063 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1064 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1065 IF( icnt(3) == jpk ) THEN 1066 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1067 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1068 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1069 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1070 ENDIF 1071 ENDIF 1072 ! 1073 ELSE 1074 ! return if istop == nstop is false 1075 RETURN 1076 ENDIF 1077 ELSE 1078 ! return if statment idvar > 0 .AND. istop == nstop is false 1079 RETURN 1080 ENDIF 1081 ! 1082 ELSE ! read using XIOS. Only if key_iomput is defined 1083 #if defined key_iomput 1084 ! will not handle scale factor and offset 1085 !would be good to be able to check which context is active and swap only if current is not restart 1086 CALL iom_swap( TRIM(rxios_context) ) 1087 IF( PRESENT(pv_r3d) ) THEN 1088 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1089 CALL xios_recv_field( trim(cdvar), pv_r3d) 1090 IF(idom /= jpdom_unknown ) CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1091 ELSEIF( PRESENT(pv_r2d) ) THEN 1092 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1093 CALL xios_recv_field( trim(cdvar), pv_r2d) 1094 IF(idom /= jpdom_unknown ) CALL lbc_lnk(pv_r2d,'Z',-999.,'no0') 1095 ELSEIF( PRESENT(pv_r1d) ) THEN 1096 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1097 CALL xios_recv_field( trim(cdvar), pv_r1d) 1098 ENDIF 1099 if(lwp) write(numout,*) 'XIOS RST READ END: ',trim(cdvar) 1100 CALL iom_swap( TRIM(cxios_context) ) 1101 #else 1102 istop = istop + 1 1103 clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 1104 #endif 1105 ENDIF 1106 !some final adjustments 1107 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1108 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 1109 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 1110 1111 !--- Apply scale_factor and offset 1112 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 1113 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1114 IF( PRESENT(pv_r1d) ) THEN 1115 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 1116 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 1117 ELSEIF( PRESENT(pv_r2d) ) THEN 951 1118 !CDIR COLLAPSE 952 1119 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 953 1120 !CDIR COLLAPSE 954 955 1121 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1122 ELSEIF( PRESENT(pv_r3d) ) THEN 956 1123 !CDIR COLLAPSE 957 1124 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 958 1125 !CDIR COLLAPSE 959 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 960 ENDIF 961 ! 962 ENDIF 963 ! 964 ENDIF 965 ! 1126 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1127 ENDIF 1128 966 1129 END SUBROUTINE iom_get_123d 967 1130 … … 1230 1393 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1231 1394 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1232 ENDIF1395 ENDIF 1233 1396 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1234 1397 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
Note: See TracChangeset
for help on using the changeset viewer.
