- Timestamp:
- 2019-08-06T15:16:49+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC
- Files:
-
- 7 edited
-
fldread.F90 (modified) (11 diffs)
-
sbcapr.F90 (modified) (1 diff)
-
sbcblk.F90 (modified) (2 diffs)
-
sbcisf.F90 (modified) (1 diff)
-
sbcmod.F90 (modified) (2 diffs)
-
sbcrnf.F90 (modified) (1 diff)
-
sbcssm.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/fldread.F90
r10425 r11405 647 647 ENDIF 648 648 ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 649 CALL wgt_list( sdjf, iw )649 CALL wgt_list( sdjf, iw, lxios_blkw ) 650 650 IF( sdjf%ln_tint ) THEN ; CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,2), & 651 651 & sdjf%nrec_a(1), sdjf%lsmname ) … … 1345 1345 1346 1346 1347 SUBROUTINE wgt_list( sd, kwgt )1347 SUBROUTINE wgt_list( sd, kwgt, ldxios ) 1348 1348 !!--------------------------------------------------------------------- 1349 1349 !! *** ROUTINE wgt_list *** … … 1355 1355 TYPE( FLD ), INTENT(in ) :: sd ! field with name of weights file 1356 1356 INTEGER , INTENT(inout) :: kwgt ! index of weights 1357 LOGICAL , INTENT(in), OPTIONAL :: ldxios 1357 1358 ! 1358 1359 INTEGER :: kw, nestid ! local integer 1359 1360 LOGICAL :: found ! local logical 1361 LOGICAL :: luxios 1362 luxios = .FALSE. 1363 if(PRESENT(ldxios)) luxios = ldxios 1360 1364 !!---------------------------------------------------------------------- 1361 1365 ! … … 1381 1385 IF( .NOT.found ) THEN 1382 1386 kwgt = nxt_wgt 1383 CALL fld_weight( sd )1387 CALL fld_weight( sd, luxios ) 1384 1388 ENDIF 1385 1389 ! … … 1416 1420 1417 1421 1418 SUBROUTINE fld_weight( sd )1422 SUBROUTINE fld_weight( sd, ldxios ) 1419 1423 !!--------------------------------------------------------------------- 1420 1424 !! *** ROUTINE fld_weight *** … … 1424 1428 !!---------------------------------------------------------------------- 1425 1429 TYPE( FLD ), INTENT(in) :: sd ! field with name of weights file 1430 LOGICAL, INTENT(in), OPTIONAL :: ldxios 1426 1431 !! 1427 1432 INTEGER :: jn ! dummy loop indices … … 1435 1440 INTEGER, DIMENSION(jpi,jpj) :: data_src 1436 1441 REAL(wp), DIMENSION(jpi,jpj) :: data_tmp 1442 LOGICAL :: luxios 1437 1443 !!---------------------------------------------------------------------- 1444 luxios = .FALSE. 1445 IF(PRESENT(ldxios)) luxios = ldxios 1438 1446 ! 1439 1447 IF( nxt_wgt > tot_wgts ) THEN … … 1464 1472 CALL iom_open ( sd%wgtname, inum ) ! interpolation weights 1465 1473 IF ( inum > 0 ) THEN 1466 1474 IF(luxios) THEN 1475 CALL iom_swap(cbwxios_context) 1476 ENDIF 1467 1477 !! determine whether we have an east-west cyclic grid 1468 1478 !! from global attribute called "ew_wrap" in the weights file … … 1511 1521 WRITE(aname,'(a3,i2.2)') 'src',jn 1512 1522 data_tmp(:,:) = 0 1513 CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) ) 1523 IF(luxios) THEN 1524 CALL iom_get ( inum, jpdom_data, aname//TRIM(sd%wgtname), data_tmp(:,:), ldxios = luxios ) 1525 ELSE 1526 CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) ) 1527 ENDIF 1514 1528 data_src(:,:) = INT(data_tmp(:,:)) 1515 1529 ref_wgts(nxt_wgt)%data_jpj(:,:,jn) = 1 + (data_src(:,:)-1) / ref_wgts(nxt_wgt)%ddims(1) … … 1521 1535 WRITE(aname,'(a3,i2.2)') 'wgt',jn 1522 1536 ref_wgts(nxt_wgt)%data_wgt(:,:,jn) = 0.0 1523 CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) ) 1537 IF(luxios) THEN 1538 CALL iom_get ( inum, jpdom_data, aname//TRIM(sd%wgtname), ref_wgts(nxt_wgt)%data_wgt(:,:,jn), ldxios = luxios ) 1539 ELSE 1540 CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) ) 1541 ENDIF 1524 1542 END DO 1525 1543 CALL iom_close (inum) … … 1548 1566 nxt_wgt = nxt_wgt + 1 1549 1567 ! 1568 IF(luxios) CALL iom_swap(cxios_context) 1550 1569 ELSE 1551 1570 CALL ctl_stop( ' fld_weight : unable to read the file ' ) -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcapr.F90
r11204 r11405 156 156 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 157 157 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 158 IF(lrxios) CALL iom_swap( TRIM(crxios_context) ) 158 159 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb, ldxios = lrxios ) ! before inv. barometer ssh 160 IF(lrxios) CALL iom_swap( TRIM(cxios_context) ) 159 161 ! 160 162 ELSE !* no restart: set from nit000 values -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcblk.F90
r10535 r11405 280 280 ! 281 281 ENDIF 282 283 IF(lxios_blkw) THEN 284 CALL iom_blk_wgt_init( cbwxios_context ) 285 CALL iom_swap( cxios_context ) 286 ENDIF 287 282 288 ! 283 289 END SUBROUTINE sbc_blk_init … … 681 687 ! 682 688 END FUNCTION L_vap 689 690 SUBROUTINE iom_blk_wgt_init( cdname, ld_tmppatch ) 691 #if defined key_iomput 692 use xios 693 #endif 694 !!---------------------------------------------------------------------- 695 !! *** ROUTINE *** 696 !! 697 !! ** Purpose : initialize context for reading weights for surface 698 !! forcing 699 !! 700 !!---------------------------------------------------------------------- 701 CHARACTER(len=*), INTENT(in) :: cdname 702 LOGICAL , OPTIONAL, INTENT(in) :: ld_tmppatch 703 #if defined key_iomput 704 ! 705 INTEGER, PARAMETER :: lcname = 26 706 CHARACTER(len=lc) :: clname 707 INTEGER :: ji, jkmin 708 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity 709 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files 710 INTEGER :: nldj_save, nlej_save !: 711 LOGICAL :: ll_global = .FALSE. !: do we have variable on model grid 712 CHARACTER(len=lc), DIMENSION( jpts) :: cg_name(jpts) 713 CHARACTER(len=1), DIMENSION(lcname) :: cname 714 CHARACTER(len=lc) :: cfname ! file name without .nc 715 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0), & 716 outp_frq = xios_duration(0, 0, 0, 0, 0, 0) 717 TYPE(xios_domaingroup) :: domaingroup_hdl 718 TYPE(xios_domain) :: domain_hdl 719 TYPE(xios_axisgroup) :: axisgroup_hdl 720 TYPE(xios_axis) :: axis_hdl 721 TYPE(xios_scalar) :: scalar_hdl 722 TYPE(xios_scalargroup) :: scalargroup_hdl 723 TYPE(xios_file) :: file_hdl 724 TYPE(xios_filegroup) :: filegroup_hdl 725 TYPE(xios_field) :: field_hdl 726 INTEGER :: jf, ni, nj, ipos, jfld 727 INTEGER, DIMENSION(3) :: ndims ! size of each dimension. this is surface 728 ! forcing, not more than 3: (x, y, t) 729 INTEGER :: ndim ! number if dimensions 730 INTEGER :: inum ! file id 731 INTEGER :: ivid ! varable id in netcdf file 732 CHARACTER (len=5) :: aname !name of the field in wght file 733 INTEGER :: numwgt ! 734 LOGICAL :: lfound 735 INTEGER :: jg, id, jn 736 737 738 cname(:)= (/'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', & 739 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', & 740 'u', 'v', 'w', 'x', 'y', 'z'/) 741 !!---------------------------------------------------------------------- 742 ! 743 ! seb: patch before we remove periodicity and close boundaries in output files 744 IF ( ll_tmppatch ) THEN 745 nldi_save = nldi ; nlei_save = nlei 746 nldj_save = nldj ; nlej_save = nlej 747 IF( nimpp == 1 ) nldi = 1 748 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 749 IF( njmpp == 1 ) nldj = 1 750 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 751 ENDIF 752 ! 753 jfld = SIZE(sf) 754 755 IF(jfld > lcname) THEN 756 STOP 'lcname number is too small' 757 ENDIF 758 759 clname = cdname 760 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) 761 CALL xios_context_initialize(TRIM(clname), mpi_comm_oce) 762 CALL iom_swap( cdname ) 763 ! Calendar type is now defined in xml file 764 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 765 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1948, 01, 01, 00, 00, 00), & 766 & start_date = xios_date(nyear, nmonth, nday,00,00,00) ) 767 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(1948, 01, 01, 00, 00, 00), & 768 & start_date = xios_date(nyear, nmonth, nday,00,00,00) ) 769 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(1948, 01, 01, 00, 00, 00), & 770 & start_date = xios_date(nyear, nmonth, nday, 00, 00, 00) ) 771 END SELECT 772 773 774 dtime%month = 1 775 CALL xios_set_timestep( dtime ) 776 777 CALL xios_get_handle("domain_definition",domaingroup_hdl) 778 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_global") 779 ni = nlei-nldi+1 780 nj = nlej-nldj+1 781 CALL xios_set_domain_attr("grid_global", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 782 CALL xios_set_domain_attr("grid_global", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 783 CALL xios_set_domain_attr("grid_global", type='curvilinear') 784 785 CALL xios_get_handle("file_definition", filegroup_hdl ) 786 787 DO jf = 1, jfld 788 !do we have weights file defined already? 789 lfound = .FALSE. 790 DO jg = 1, jf-1 791 IF(TRIM(sf(jf)%wgtname) == TRIM(sf(jg)%wgtname)) THEN 792 IF(lwp) write(numout, *) TRIM(sf(jf)%wgtname),' already defined, skipping ' 793 lfound = .TRUE. 794 exit 795 ENDIF 796 ENDDO 797 IF(lfound) cycle 798 !add next weights file 799 ipos = index(sf(jf)%wgtname,'.nc') 800 cfname(1:lc) = " " 801 IF(ipos > 0) THEN 802 cfname(1:ipos-1) = sf(jf)%wgtname(1:ipos-1) 803 ELSE 804 cfname(1:lc) = sf(jf)%wgtname(1:lc) 805 ENDIF 806 807 CALL xios_add_child(filegroup_hdl, file_hdl, cname(jf)) 808 CALL xios_set_file_attr( cname(jf), name=TRIM(cfname), & 809 type="one_file", par_access="collective", enabled=.TRUE., & 810 output_freq=xios_timestep, mode="read") 811 812 CALL iom_open ( sf(jf)%wgtname, inum ) 813 id = iom_varid(inum, 'src05', ldstop=.FALSE.) 814 IF(id <= 0) THEN 815 numwgt = 4 816 ELSE 817 numwgt = 16 818 ENDIF 819 CALL iom_close ( inum ) 820 !define variables in weights file. Because all files have the same names src01, 821 !dst01, ... add filename to the name to uniquely identify variables 822 aname = ' ' 823 DO jn = 1, numwgt 824 WRITE(aname,'(a3,i2.2)') 'src',jn 825 CALL xios_add_child(file_hdl, field_hdl, TRIM(aname)//TRIM(sf(jf)%wgtname)) 826 CALL xios_set_attr (field_hdl, enabled = .TRUE., & 827 name = TRIM(aname), domain_ref="grid_global", & 828 operation = "instant") 829 CALL xios_add_child(file_hdl, field_hdl, TRIM(aname)//TRIM(sf(jf)%wgtname)) 830 CALL xios_set_attr (field_hdl, enabled = .TRUE., & 831 name = TRIM(aname), domain_ref="grid_global", & 832 operation = "instant") 833 ENDDO 834 ENDDO 835 836 837 CALL xios_close_context_definition() 838 CALL xios_update_calendar( 0 ) 839 840 IF ( ll_tmppatch ) THEN 841 nldi = nldi_save ; nlei = nlei_save 842 nldj = nldj_save ; nlej = nlej_save 843 ENDIF 844 #endif 845 ! 846 END SUBROUTINE iom_blk_wgt_init 847 683 848 684 849 #if defined key_si3 -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcisf.F90
r10536 r11405 207 207 & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN 208 208 IF(lwp) WRITE(numout,*) ' nit000-1 isf tracer content forcing fields read in the restart file' 209 IF(lrxios) CALL iom_swap( TRIM(crxios_context) ) 209 210 CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) , ldxios = lrxios ) ! before salt content isf_tsc trend 210 211 CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b' , risf_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content isf_tsc trend 211 212 CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b' , risf_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before salt content isf_tsc trend 213 IF(lrxios) CALL iom_swap( TRIM(cxios_context) ) 212 214 ELSE 213 215 fwfisf_b(:,:) = fwfisf(:,:) -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcmod.F90
r10499 r11405 496 496 & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 497 497 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 498 IF(lrxios) CALL iom_swap( TRIM(crxios_context) ) 498 499 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios ) ! before i-stress (U-point) 499 500 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios ) ! before j-stress (V-point) … … 508 509 sfx_b (:,:) = sfx(:,:) 509 510 ENDIF 511 IF(lrxios) CALL iom_swap( TRIM(cxios_context) ) 510 512 ELSE !* no restart: set from nit000 values 511 513 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000' -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcrnf.F90
r10523 r11405 146 146 IF( ln_rstart .AND. & !* Restart: read in restart file 147 147 & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 148 IF(lrxios) CALL iom_swap( TRIM(crxios_context) ) 148 149 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file', lrxios 149 150 CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b, ldxios = lrxios ) ! before runoff 150 151 CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before heat content of runoff 151 152 CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salinity content of runoff 153 IF(lrxios) CALL iom_swap( TRIM(cxios_context) ) 152 154 ELSE !* no restart: set from nit000 values 153 155 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' -
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/sbcssm.F90
r10425 r11405 209 209 IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 210 210 l_ssm_mean = .TRUE. 211 IF(lrxios) CALL iom_swap( TRIM(crxios_context) ) 211 212 CALL iom_get( numror , 'nn_fsbc', zf_sbc, ldxios = lrxios ) ! sbc frequency of previous run 212 213 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m, ldxios = lrxios ) ! sea surface mean velocity (U-point) … … 222 223 frq_m(:,:) = 1._wp ! default definition 223 224 ENDIF 225 IF(lrxios) CALL iom_swap( TRIM(cxios_context) ) 224 226 ! 225 227 IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN ! nn_fsbc has changed between 2 runs
Note: See TracChangeset
for help on using the changeset viewer.
