Ignore:
Timestamp:
2020-05-19T12:53:16+02:00 (5 months ago)
Author:
andmirek
Message:

Ticket #2462: new XIOS restart read/write interfaces

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_12905_xios_restart/src/OCE/IOM/iom.F90

    r12914 r12950  
    4646   USE lib_fortran  
    4747   USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 
     48   USE iom_nf90 
     49   USE netcdf 
    4850 
    4951   IMPLICIT NONE 
     
    6567   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 
    6668   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate 
    67    PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active 
     69   PRIVATE iom_set_rst_context, iom_set_rstr_active 
    6870# endif 
    69    PUBLIC iom_set_rstw_var_active, iom_set_rstw_core, iom_set_rst_vars 
     71   PRIVATE iom_set_rstw_active 
    7072 
    7173   INTERFACE iom_get 
     
    261263!set names of the fields in restart file IF using XIOS to read data 
    262264          CALL iom_set_rst_context(.TRUE.) 
    263           CALL iom_set_rst_vars(rst_rfields) 
    264265!set which fields are to be read from restart file 
    265266          CALL iom_set_rstr_active() 
    266267      ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 
    267 !set names of the fields in restart file IF using XIOS to write data 
    268           CALL iom_set_rst_context(.FALSE.) 
    269           CALL iom_set_rst_vars(rst_wfields) 
    270 !set which fields are to be written to a restart file 
    271           CALL iom_set_rstw_active(fname) 
     268          CALL iom_set_rstw_file(fname) 
    272269      ELSE 
    273270          CALL set_xmlatt 
     
    291288   END SUBROUTINE iom_init 
    292289 
    293    SUBROUTINE iom_init_closedef 
     290   SUBROUTINE iom_init_closedef(cdname) 
    294291      !!---------------------------------------------------------------------- 
    295292      !!            ***  SUBROUTINE iom_init_closedef  *** 
     
    299296      !! 
    300297      !!---------------------------------------------------------------------- 
    301  
     298   CHARACTER(len=*), OPTIONAL, INTENT(IN) :: cdname 
    302299#if defined key_iomput 
     300      IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 
     301!set names of the fields in restart file IF using XIOS to write data 
     302          CALL iom_set_rst_context(.FALSE.) 
     303      ENDIF 
     304 
    303305      CALL xios_close_context_definition() 
    304       CALL xios_update_calendar( 0 ) 
     306 
     307      IF(.NOT. (TRIM(cdname) == TRIM(cwxios_context)))  CALL xios_update_calendar( 0 ) 
     308 
    305309#else 
    306310      IF( .FALSE. )   WRITE(numout,*) 'iom_init_closedef: should not see this'   ! useless statement to avoid compilation warnings 
     
    308312 
    309313   END SUBROUTINE iom_init_closedef 
    310  
    311    SUBROUTINE iom_set_rstw_var_active(field) 
    312       !!--------------------------------------------------------------------- 
    313       !!                   ***  SUBROUTINE  iom_set_rstw_var_active  *** 
    314       !! 
    315       !! ** Purpose :  enable variable in restart file when writing with XIOS  
    316       !!--------------------------------------------------------------------- 
    317    CHARACTER(len = *), INTENT(IN) :: field 
    318    INTEGER :: i 
    319    LOGICAL :: llis_set 
    320    CHARACTER(LEN=256) :: clinfo    ! info character 
    321  
    322 #if defined key_iomput 
    323    llis_set = .FALSE. 
    324  
    325    DO i = 1, max_rst_fields 
    326        IF(TRIM(rst_wfields(i)%vname) == field) THEN  
    327           rst_wfields(i)%active = .TRUE. 
    328           llis_set = .TRUE. 
    329           EXIT 
    330        ENDIF 
    331    ENDDO 
    332 !Warn if variable is not in defined in rst_wfields 
    333    IF(.NOT.llis_set) THEN 
    334       WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined'  
    335       CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 ) 
    336    ENDIF 
    337 #else 
    338         clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality' 
    339         CALL ctl_stop('STOP', TRIM(clinfo)) 
    340 #endif 
    341  
    342    END SUBROUTINE iom_set_rstw_var_active 
    343314 
    344315   SUBROUTINE iom_set_rstr_active() 
     
    352323!sets enabled = .TRUE. for each field in restart file 
    353324   CHARACTER(len=256) :: rst_file 
    354  
    355325#if defined key_iomput 
    356    TYPE(xios_field) :: field_hdl 
    357    TYPE(xios_file) :: file_hdl 
    358    TYPE(xios_filegroup) :: filegroup_hdl 
    359    INTEGER :: i 
    360    CHARACTER(lc)  ::   clpath 
     326   INTEGER                                    :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims 
     327   TYPE(xios_field)                           :: field_hdl 
     328   TYPE(xios_file)                            :: file_hdl 
     329   TYPE(xios_filegroup)                       :: filegroup_hdl 
     330   INTEGER                                    :: dimids(4), jv,i, idim 
     331   CHARACTER(LEN=lc)                          :: clpath 
     332   CHARACTER(LEN=256)                         :: clinfo               ! info character 
     333   INTEGER, ALLOCATABLE                       :: indimlens(:) 
     334   CHARACTER(LEN=nf90_max_name), ALLOCATABLE  :: indimnames(:) 
     335   CHARACTER(LEN=nf90_max_name)               :: dimname, varname 
     336   LOGICAL                                    :: lmeta 
     337 
     338!failed to build with AGRIF 
     339!      meta(1:NMETA) = ["nav_lat",        & 
     340!            "nav_lon", "nav_lev", "time_instant",                  & 
     341!            "time_instant_bounds", "time_counter",                 & 
     342!            "time_counter_bounds", "x", "y", "numcat"] 
     343 
     344        meta(1) = "nav_lat" 
     345        meta(2) = "nav_lon" 
     346        meta(3) = "nav_lev" 
     347        meta(4) = "time_instant" 
     348        meta(5) = "time_instant_bounds" 
     349        meta(6) = "time_counter" 
     350        meta(7) = "time_counter_bounds" 
     351        meta(8) = "x" 
     352        meta(9) = "y" 
     353        meta(10) = "numcat" 
    361354 
    362355        clpath = TRIM(cn_ocerst_indir) 
     
    367360           rst_file = TRIM(clpath)//TRIM(Agrif_CFixed())//'_'//TRIM(cn_ocerst_in) 
    368361        ENDIF 
     362 
     363        clinfo = '          iom_set_rstr_active, file: '//TRIM(rst_file) 
     364 
    369365!set name of the restart file and enable available fields 
    370         if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ', TRIM(rst_file) 
    371366        CALL xios_get_handle("file_definition", filegroup_hdl ) 
    372367        CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 
     
    374369             par_access="collective", enabled=.TRUE., mode="read",                 & 
    375370             output_freq=xios_timestep) 
    376 !define variables for restart context 
    377         DO i = 1, max_rst_fields 
    378          IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 
    379            IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 
    380                 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 
    381                 SELECT CASE (TRIM(rst_rfields(i)%grid)) 
    382                  CASE ("grid_N_3D") 
    383                     CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 
    384                         domain_ref="grid_N", axis_ref="nav_lev", operation = "instant") 
    385                  CASE ("grid_N") 
    386                     CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 
    387                         domain_ref="grid_N", operation = "instant")  
    388                 CASE ("grid_vector") 
    389                     CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 
    390                          axis_ref="nav_lev", operation = "instant") 
    391                  CASE ("grid_scalar") 
    392                     CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 
    393                         scalar_ref = "grid_scalar", operation = "instant") 
    394                 END SELECT 
    395                 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 
    396            ENDIF 
    397          ENDIF 
    398         END DO 
     371 
     372        CALL iom_nf90_check( nf90_inquire( iom_file(numror)%nfid, ndims, nvars, natts ), clinfo ) 
     373        ALLOCATE(indimlens(ndims), indimnames(ndims)) 
     374        CALL iom_nf90_check( nf90_inquire( iom_file(numror)%nfid, unlimitedDimId = unlimitedDimId ), clinfo ) 
     375 
     376        DO idim = 1, ndims 
     377           CALL iom_nf90_check( nf90_inquire_dimension( iom_file(numror)%nfid, idim, dimname, dimlen ), clinfo ) 
     378           indimlens(idim) = dimlen 
     379           indimnames(idim) = dimname 
     380        ENDDO 
     381 
     382        DO jv =1, nvars 
     383            lmeta = .FALSE. 
     384            CALL iom_nf90_check( nf90_inquire_variable( iom_file(numror)%nfid, jv, varname, xtype, ndims, dimids, natts ), clinfo ) 
     385            DO i = 1, NMETA 
     386               IF(TRIM(varname) == TRIM(meta(i))) THEN 
     387                  lmeta = .TRUE. 
     388               ENDIF 
     389            ENDDO 
     390            IF(.NOT.lmeta) THEN 
     391               CALL xios_add_child(file_hdl, field_hdl, TRIM(varname)) 
     392               mdims = ndims 
     393 
     394               IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN 
     395                mdims = mdims - 1 
     396               ENDIF 
     397 
     398               IF(mdims == 3) THEN 
     399                      CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname),   & 
     400                                   domain_ref="grid_N", axis_ref=TRIM(iom_axis(indimlens(ndims))), & 
     401                                   prec = 8, operation = "instant") 
     402               ELSEIF(mdims == 2) THEN 
     403                      CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), & 
     404                                          domain_ref="grid_N", prec = 8, operation = "instant")  
     405               ELSEIF(mdims == 1) THEN 
     406                      CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), & 
     407                                          axis_ref=TRIM(iom_axis(indimlens(ndims))), prec = 8, operation = "instant") 
     408               ELSEIF(mdims == 0) THEN 
     409                      CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(varname), & 
     410                                                scalar_ref = "grid_scalar", prec = 8, operation = "instant") 
     411               ELSE 
     412                   WRITE(ctmp1,*) 'iom_set_rstr_active: variable ', TRIM(varname) ,' incorrect number of dimensions'  
     413                   CALL ctl_stop( 'iom_set_rstr_active:', ctmp1 ) 
     414               ENDIF 
     415            ENDIF 
     416        ENDDO 
     417        DEALLOCATE(indimlens, indimnames) 
    399418#endif 
    400419   END SUBROUTINE iom_set_rstr_active 
    401420 
    402    SUBROUTINE iom_set_rstw_core(cdmdl) 
     421   SUBROUTINE iom_set_rstw_file(cdrst_file) 
    403422      !!--------------------------------------------------------------------- 
    404       !!                   ***  SUBROUTINE  iom_set_rstw_core  *** 
    405       !! 
    406       !! ** Purpose :  set variables which are always in restart file  
     423      !!                   ***  SUBROUTINE iom_set_rstw_file   *** 
     424      !! 
     425      !! ** Purpose :  define file name in XIOS context for writing restart 
    407426      !!--------------------------------------------------------------------- 
    408    CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS 
    409    CHARACTER(LEN=256)             :: clinfo    ! info character 
    410 #if defined key_iomput 
    411    IF(cdmdl == "OPA") THEN 
    412 !from restart.F90 
    413    CALL iom_set_rstw_var_active("rdt") 
    414    IF ( .NOT. ln_diurnal_only ) THEN 
    415         CALL iom_set_rstw_var_active('ub'  ) 
    416         CALL iom_set_rstw_var_active('vb'  ) 
    417         CALL iom_set_rstw_var_active('tb'  ) 
    418         CALL iom_set_rstw_var_active('sb'  ) 
    419         CALL iom_set_rstw_var_active('sshb') 
    420         ! 
    421         CALL iom_set_rstw_var_active('un'  ) 
    422         CALL iom_set_rstw_var_active('vn'  ) 
    423         CALL iom_set_rstw_var_active('tn'  ) 
    424         CALL iom_set_rstw_var_active('sn'  ) 
    425         CALL iom_set_rstw_var_active('sshn') 
    426         CALL iom_set_rstw_var_active('rhop') 
    427       ENDIF 
    428       IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 
    429 !from trasbc.F90 
    430          CALL iom_set_rstw_var_active('sbc_hc_b') 
    431          CALL iom_set_rstw_var_active('sbc_sc_b') 
    432    ENDIF 
    433 #else 
    434         clinfo = 'iom_set_rstw_core: key_iomput is needed to use XIOS restart read/write functionality' 
    435         CALL ctl_stop('STOP', TRIM(clinfo)) 
    436 #endif 
    437    END SUBROUTINE iom_set_rstw_core 
    438  
    439    SUBROUTINE iom_set_rst_vars(fields) 
    440       !!--------------------------------------------------------------------- 
    441       !!                   ***  SUBROUTINE iom_set_rst_vars   *** 
    442       !! 
    443       !! ** Purpose :  Fill array fields with the information about all  
    444       !!               possible variables and corresponding grids definition  
    445       !!               for reading/writing restart with XIOS 
    446       !!--------------------------------------------------------------------- 
    447    TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields) 
    448    INTEGER :: i 
    449  
    450         i = 0 
    451         i = i + 1; fields(i)%vname="rdt";            fields(i)%grid="grid_scalar" 
    452         i = i + 1; fields(i)%vname="un";             fields(i)%grid="grid_N_3D" 
    453         i = i + 1; fields(i)%vname="ub";             fields(i)%grid="grid_N_3D" 
    454         i = i + 1; fields(i)%vname="vn";             fields(i)%grid="grid_N_3D" 
    455         i = i + 1; fields(i)%vname="vb";             fields(i)%grid="grid_N_3D"   
    456         i = i + 1; fields(i)%vname="tn";             fields(i)%grid="grid_N_3D" 
    457         i = i + 1; fields(i)%vname="tb";             fields(i)%grid="grid_N_3D" 
    458         i = i + 1; fields(i)%vname="sn";             fields(i)%grid="grid_N_3D" 
    459         i = i + 1; fields(i)%vname="sb";             fields(i)%grid="grid_N_3D" 
    460         i = i + 1; fields(i)%vname="sshn";           fields(i)%grid="grid_N" 
    461         i = i + 1; fields(i)%vname="sshb";           fields(i)%grid="grid_N" 
    462         i = i + 1; fields(i)%vname="rhop";           fields(i)%grid="grid_N_3D" 
    463         i = i + 1; fields(i)%vname="kt";             fields(i)%grid="grid_scalar" 
    464         i = i + 1; fields(i)%vname="ndastp";         fields(i)%grid="grid_scalar" 
    465         i = i + 1; fields(i)%vname="adatrj";         fields(i)%grid="grid_scalar" 
    466         i = i + 1; fields(i)%vname="utau_b";         fields(i)%grid="grid_N" 
    467         i = i + 1; fields(i)%vname="vtau_b";         fields(i)%grid="grid_N" 
    468         i = i + 1; fields(i)%vname="qns_b";          fields(i)%grid="grid_N" 
    469         i = i + 1; fields(i)%vname="emp_b";          fields(i)%grid="grid_N" 
    470         i = i + 1; fields(i)%vname="sfx_b";          fields(i)%grid="grid_N" 
    471         i = i + 1; fields(i)%vname="en" ;            fields(i)%grid="grid_N_3D"  
    472         i = i + 1; fields(i)%vname="avt_k";            fields(i)%grid="grid_N_3D" 
    473         i = i + 1; fields(i)%vname="avm_k";            fields(i)%grid="grid_N_3D" 
    474         i = i + 1; fields(i)%vname="dissl";          fields(i)%grid="grid_N_3D" 
    475         i = i + 1; fields(i)%vname="sbc_hc_b";       fields(i)%grid="grid_N" 
    476         i = i + 1; fields(i)%vname="sbc_sc_b";       fields(i)%grid="grid_N" 
    477         i = i + 1; fields(i)%vname="qsr_hc_b";       fields(i)%grid="grid_N_3D" 
    478         i = i + 1; fields(i)%vname="fraqsr_1lev";    fields(i)%grid="grid_N" 
    479         i = i + 1; fields(i)%vname="frc_v";          fields(i)%grid="grid_scalar" 
    480         i = i + 1; fields(i)%vname="frc_t";          fields(i)%grid="grid_scalar" 
    481         i = i + 1; fields(i)%vname="frc_s";          fields(i)%grid="grid_scalar" 
    482         i = i + 1; fields(i)%vname="frc_wn_t";       fields(i)%grid="grid_scalar" 
    483         i = i + 1; fields(i)%vname="frc_wn_s";       fields(i)%grid="grid_scalar" 
    484         i = i + 1; fields(i)%vname="ssh_ini";        fields(i)%grid="grid_N" 
    485         i = i + 1; fields(i)%vname="e3t_ini";        fields(i)%grid="grid_N_3D" 
    486         i = i + 1; fields(i)%vname="hc_loc_ini";     fields(i)%grid="grid_N_3D" 
    487         i = i + 1; fields(i)%vname="sc_loc_ini";     fields(i)%grid="grid_N_3D" 
    488         i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N" 
    489         i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N" 
    490         i = i + 1; fields(i)%vname="tilde_e3t_b";    fields(i)%grid="grid_N" 
    491         i = i + 1; fields(i)%vname="tilde_e3t_n";    fields(i)%grid="grid_N" 
    492         i = i + 1; fields(i)%vname="hdiv_lf";        fields(i)%grid="grid_N" 
    493         i = i + 1; fields(i)%vname="ub2_b";          fields(i)%grid="grid_N" 
    494         i = i + 1; fields(i)%vname="vb2_b";          fields(i)%grid="grid_N" 
    495         i = i + 1; fields(i)%vname="sshbb_e";        fields(i)%grid="grid_N" 
    496         i = i + 1; fields(i)%vname="ubb_e";          fields(i)%grid="grid_N" 
    497         i = i + 1; fields(i)%vname="vbb_e";          fields(i)%grid="grid_N" 
    498         i = i + 1; fields(i)%vname="sshb_e";         fields(i)%grid="grid_N" 
    499         i = i + 1; fields(i)%vname="ub_e";           fields(i)%grid="grid_N" 
    500         i = i + 1; fields(i)%vname="vb_e";           fields(i)%grid="grid_N" 
    501         i = i + 1; fields(i)%vname="fwf_isf_b";      fields(i)%grid="grid_N" 
    502         i = i + 1; fields(i)%vname="isf_sc_b";       fields(i)%grid="grid_N" 
    503         i = i + 1; fields(i)%vname="isf_hc_b";       fields(i)%grid="grid_N" 
    504         i = i + 1; fields(i)%vname="ssh_ibb";        fields(i)%grid="grid_N" 
    505         i = i + 1; fields(i)%vname="rnf_b";          fields(i)%grid="grid_N" 
    506         i = i + 1; fields(i)%vname="rnf_hc_b";       fields(i)%grid="grid_N" 
    507         i = i + 1; fields(i)%vname="rnf_sc_b";       fields(i)%grid="grid_N" 
    508         i = i + 1; fields(i)%vname="nn_fsbc";        fields(i)%grid="grid_scalar" 
    509         i = i + 1; fields(i)%vname="ssu_m";          fields(i)%grid="grid_N" 
    510         i = i + 1; fields(i)%vname="ssv_m";          fields(i)%grid="grid_N" 
    511         i = i + 1; fields(i)%vname="sst_m";          fields(i)%grid="grid_N" 
    512         i = i + 1; fields(i)%vname="sss_m";          fields(i)%grid="grid_N" 
    513         i = i + 1; fields(i)%vname="ssh_m";          fields(i)%grid="grid_N" 
    514         i = i + 1; fields(i)%vname="e3t_m";          fields(i)%grid="grid_N" 
    515         i = i + 1; fields(i)%vname="frq_m";          fields(i)%grid="grid_N" 
    516         i = i + 1; fields(i)%vname="avmb";           fields(i)%grid="grid_vector" 
    517         i = i + 1; fields(i)%vname="avtb";           fields(i)%grid="grid_vector" 
    518         i = i + 1; fields(i)%vname="ub2_i_b";        fields(i)%grid="grid_N" 
    519         i = i + 1; fields(i)%vname="vb2_i_b";        fields(i)%grid="grid_N" 
    520         i = i + 1; fields(i)%vname="ntime";          fields(i)%grid="grid_scalar" 
    521         i = i + 1; fields(i)%vname="Dsst";           fields(i)%grid="grid_scalar" 
    522         i = i + 1; fields(i)%vname="tmask";          fields(i)%grid="grid_N_3D" 
    523         i = i + 1; fields(i)%vname="umask";          fields(i)%grid="grid_N_3D" 
    524         i = i + 1; fields(i)%vname="vmask";          fields(i)%grid="grid_N_3D" 
    525         i = i + 1; fields(i)%vname="smask";          fields(i)%grid="grid_N_3D" 
    526         i = i + 1; fields(i)%vname="gdepw_n";        fields(i)%grid="grid_N_3D" 
    527         i = i + 1; fields(i)%vname="e3t_n";          fields(i)%grid="grid_N_3D" 
    528         i = i + 1; fields(i)%vname="e3u_n";          fields(i)%grid="grid_N_3D" 
    529         i = i + 1; fields(i)%vname="e3v_n";          fields(i)%grid="grid_N_3D" 
    530         i = i + 1; fields(i)%vname="surf_ini";       fields(i)%grid="grid_N" 
    531         i = i + 1; fields(i)%vname="e3t_b";          fields(i)%grid="grid_N_3D" 
    532         i = i + 1; fields(i)%vname="hmxl_n";         fields(i)%grid="grid_N_3D" 
    533         i = i + 1; fields(i)%vname="un_bf";          fields(i)%grid="grid_N" 
    534         i = i + 1; fields(i)%vname="vn_bf";          fields(i)%grid="grid_N" 
    535         i = i + 1; fields(i)%vname="hbl";            fields(i)%grid="grid_N" 
    536         i = i + 1; fields(i)%vname="hbli";           fields(i)%grid="grid_N" 
    537         i = i + 1; fields(i)%vname="wn";             fields(i)%grid="grid_N_3D" 
    538         i = i + 1; fields(i)%vname="fwfisf_cav_b";   fields(i)%grid="grid_N" 
    539         i = i + 1; fields(i)%vname="isf_hc_cav_b";   fields(i)%grid="grid_N" 
    540         i = i + 1; fields(i)%vname="isf_sc_cav_b";   fields(i)%grid="grid_N" 
    541  
    542         IF( i-1 > max_rst_fields) THEN 
    543            WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 
    544            CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 ) 
    545         ENDIF 
    546    END SUBROUTINE iom_set_rst_vars 
    547  
    548  
    549    SUBROUTINE iom_set_rstw_active(cdrst_file) 
    550       !!--------------------------------------------------------------------- 
    551       !!                   ***  SUBROUTINE iom_set_rstw_active   *** 
    552       !! 
    553       !! ** Purpose :  define file name in XIOS context for writing restart 
    554       !!               enable variables present in restart file for writing 
    555       !!--------------------------------------------------------------------- 
    556 !sets enabled = .TRUE. for each field in restart file 
    557427   CHARACTER(len=*) :: cdrst_file 
    558428#if defined key_iomput 
    559    TYPE(xios_field) :: field_hdl 
    560429   TYPE(xios_file) :: file_hdl 
    561430   TYPE(xios_filegroup) :: filegroup_hdl 
     
    577446        ENDIF  
    578447        CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 
     448#endif 
     449   END SUBROUTINE iom_set_rstw_file 
     450 
     451 
     452   SUBROUTINE iom_set_rstw_active(sdfield, rd0, rd1, rd2, rd3) 
     453      !!--------------------------------------------------------------------- 
     454      !!                   ***  SUBROUTINE iom_set_rstw_active   *** 
     455      !! 
     456      !! ** Purpose :  define file name in XIOS context for writing restart 
     457      !!               enable variables present in restart file for writing 
     458      !!--------------------------------------------------------------------- 
     459!sets enabled = .TRUE. for each field in restart file 
     460   CHARACTER(len = *), INTENT(IN)                     :: sdfield 
     461   REAL(wp), OPTIONAL, INTENT(IN)                     :: rd0 
     462   REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(:)       :: rd1 
     463   REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(:, :)    :: rd2 
     464   REAL(wp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3   
     465#if defined key_iomput 
     466   TYPE(xios_field) :: field_hdl 
     467   TYPE(xios_file) :: file_hdl 
     468   INTEGER :: i 
     469   CHARACTER(lc)  ::   clpath 
     470   CHARACTER(len=1024) :: fname 
     471   CHARACTER(len=lc)   :: axis_ref 
     472 
     473        CALL xios_get_handle("wrestart", file_hdl) 
     474!       CALL xios_get_file_attr("wrestart", name = fname ) 
     475!       IF(lwp) write(numout, *) TRIM(fname), ' File to write' 
     476!       IF(lwp) call flush(numout) 
    579477!define fields for restart context 
    580         DO i = 1, max_rst_fields 
    581          IF( rst_wfields(i)%active ) THEN 
    582                 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 
    583                 SELECT CASE (TRIM(rst_wfields(i)%grid)) 
    584                  CASE ("grid_N_3D") 
    585                     CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 
    586                         domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant") 
    587                  CASE ("grid_N") 
    588                     CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 
    589                         domain_ref="grid_N", prec = 8, operation = "instant")  
    590                  CASE ("grid_vector") 
    591                     CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 
    592                          axis_ref="nav_lev", prec = 8, operation = "instant") 
    593                  CASE ("grid_scalar") 
    594                     CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 
    595                         scalar_ref = "grid_scalar", prec = 8, operation = "instant") 
    596                 END SELECT 
    597          ENDIF 
    598         END DO 
     478        CALL xios_add_child(file_hdl, field_hdl, TRIM(sdfield)) 
     479 
     480        IF(PRESENT(rd3)) THEN 
     481               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(sdfield),   & 
     482                            domain_ref="grid_N", axis_ref=TRIM(iom_axis(size(rd3, 3))), & 
     483                            prec = 8, operation = "instant") 
     484        ENDIF 
     485 
     486        IF(PRESENT(rd2)) THEN 
     487               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(sdfield), & 
     488                                   domain_ref="grid_N", prec = 8, operation = "instant")  
     489        ENDIF 
     490 
     491        IF(PRESENT(rd1)) THEN 
     492               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(sdfield), & 
     493                                   axis_ref=TRIM(iom_axis(size(rd1, 1))), prec = 8, operation = "instant") 
     494        ENDIF 
     495 
     496        IF(PRESENT(rd0)) THEN 
     497               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(sdfield), & 
     498                                         scalar_ref = "grid_scalar", prec = 8, operation = "instant") 
     499        ENDIF 
    599500#endif 
    600501   END SUBROUTINE iom_set_rstw_active 
     502 
     503   FUNCTION iom_axis(idlev) result(axis_ref) 
     504     !!--------------------------------------------------------------------- 
     505      !!                   ***  FUNCTION  iom_axis  *** 
     506      !! 
     507      !! ** Purpose : Used for grid definition when XIOS is used to read/write 
     508      !!              restart. Returns axis corresponding to the number of levels 
     509      !!              given as an input variable. Axes are defined in routine  
     510      !!              iom_set_rst_context 
     511      !!--------------------------------------------------------------------- 
     512    INTEGER, INTENT(IN) :: idlev 
     513    CHARACTER(len=lc)   :: axis_ref 
     514    CHARACTER(len=12)   :: str 
     515       IF(idlev == jpk) THEN 
     516         axis_ref="nav_lev" 
     517#if defined key_si3 
     518       ELSEIF(idlev == jpl) THEN 
     519         axis_ref="numcat" 
     520#endif          
     521       ELSE 
     522         write(str, *) idlev 
     523         CALL ctl_stop( 'iom_axis', 'Definition for axis with '//TRIM(ADJUSTL(str))//' levels missing') 
     524       ENDIF 
     525   END FUNCTION iom_axis 
    601526 
    602527   SUBROUTINE iom_set_rst_context(ld_rstr)  
     
    609534      !!--------------------------------------------------------------------- 
    610535   LOGICAL, INTENT(IN)               :: ld_rstr 
    611 !ld_rstr is true for restart context. There is no need to define grid for  
    612 !restart read, because it's read from file 
     536   INTEGER :: ji 
    613537#if defined key_iomput 
    614538   TYPE(xios_domaingroup)            :: domaingroup_hdl  
     
    629553     CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 
    630554     CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d )  
     555#if defined key_si3 
     556     CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat") 
     557     CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
     558#endif 
    631559 
    632560     CALL xios_get_handle("scalar_definition", scalargroup_hdl)  
     
    974902#if defined key_iomput 
    975903         IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 
    976          CALL iom_swap( TRIM(crxios_context) ) 
    977904         CALL xios_recv_field( trim(cdvar), pvar) 
    978          CALL iom_swap( TRIM(cxios_context) ) 
    979905#else 
    980906         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 
     
    13271253#if defined key_iomput 
    13281254!would be good to be able to check which context is active and swap only if current is not restart 
    1329          CALL iom_swap( TRIM(crxios_context) )  
    13301255         IF( PRESENT(pv_r3d) ) THEN 
    13311256            pv_r3d(:, :, :) = 0. 
     
    13471272            CALL xios_recv_field( trim(cdvar), pv_r1d) 
    13481273         ENDIF 
    1349          CALL iom_swap( TRIM(cxios_context) ) 
    13501274#else 
    13511275         istop = istop + 1  
     
    15611485          IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 
    15621486          CALL xios_send_field(trim(cdvar), pvar) 
     1487      ELSE 
     1488          IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 
     1489          CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar )  
    15631490      ENDIF 
    15641491#endif 
     
    15911518         IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 
    15921519         CALL xios_send_field(trim(cdvar), pvar) 
     1520      ELSE 
     1521         IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D) ',trim(cdvar) 
     1522         CALL iom_set_rstw_active( trim(cdvar), rd1 = pvar )  
    15931523      ENDIF 
    15941524#endif 
     
    16211551         IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 
    16221552         CALL xios_send_field(trim(cdvar), pvar) 
     1553      ELSE 
     1554         IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D) ',trim(cdvar) 
     1555         CALL iom_set_rstw_active( trim(cdvar), rd2 = pvar )  
    16231556      ENDIF 
    16241557#endif 
     
    16511584         IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 
    16521585         CALL xios_send_field(trim(cdvar), pvar) 
     1586      ELSE 
     1587         IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D) ',trim(cdvar) 
     1588         CALL iom_set_rstw_active( trim(cdvar), rd3 = pvar ) 
    16531589      ENDIF 
    16541590#endif 
Note: See TracChangeset for help on using the changeset viewer.