New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14559 for NEMO/branches/2021/dev_14544_xios_ancil/src/OCE/IOM/iom.F90 – NEMO

Ignore:
Timestamp:
2021-03-01T14:37:10+01:00 (3 years ago)
Author:
andmirek
Message:

Ticket #2631: first implementation (with debug prints)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_14544_xios_ancil/src/OCE/IOM/iom.F90

    r14239 r14559  
    6161   PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 
    6262   PUBLIC iom_xios_setid 
     63   PUBLIC iom_dom_context 
    6364 
    6465   PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp 
     
    344345 
    345346#if defined key_xios 
    346       INTEGER                                    :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims 
     347      INTEGER                                    :: ndims, nvars, mdims 
    347348      TYPE(xios_field)                           :: field_hdl 
    348349      TYPE(xios_file)                            :: file_hdl 
     
    350351      INTEGER                                    :: dimids(4), jv,i, idim 
    351352      CHARACTER(LEN=256)                         :: clinfo               ! info character 
    352       INTEGER, ALLOCATABLE                       :: indimlens(:) 
    353       CHARACTER(LEN=nf90_max_name), ALLOCATABLE  :: indimnames(:) 
    354       CHARACTER(LEN=nf90_max_name)               :: dimname, varname 
     353      INTEGER                                    :: indimlens(4) 
     354      CHARACTER(LEN=lc)                          :: dimname, varname 
    355355      INTEGER                                    :: iln 
     356      INTEGER                                    :: ivid 
    356357      CHARACTER(LEN=lc)                          :: fname 
     358      LOGICAL                                    :: lud 
    357359      LOGICAL                                    :: lmeta 
    358360!metadata in restart file for restart read with XIOS 
     
    371373      meta(9) = "y" 
    372374      meta(10) = "numcat" 
     375!     meta(11) = "t" 
    373376 
    374377      clinfo = '          iom_set_vars_active, file: '//TRIM(iom_file(idnum)%name) 
     
    384387!set name of the restart file and enable available fields 
    385388      CALL xios_get_handle("file_definition", filegroup_hdl ) 
    386       CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 
    387       CALL xios_set_file_attr( "rrestart", name=fname, type="one_file",      & 
     389      CALL xios_add_child(filegroup_hdl, file_hdl, 'finput') 
     390      CALL xios_set_file_attr( "finput", name=fname, type="one_file",      & 
    388391           par_access="collective", enabled=.TRUE., mode="read",              & 
    389392                                                    output_freq=xios_timestep ) 
    390393 
    391       CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, ndims, nvars, natts ), clinfo ) 
    392       ALLOCATE(indimlens(ndims), indimnames(ndims)) 
    393       CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, unlimitedDimId = unlimitedDimId ), clinfo ) 
    394  
    395       DO idim = 1, ndims 
    396          CALL iom_nf90_check( nf90_inquire_dimension(iom_file(idnum)%nfid, idim, dimname, dimlen ), clinfo ) 
    397          indimlens(idim) = dimlen 
    398          indimnames(idim) = dimname 
    399       ENDDO 
    400  
    401       DO jv =1, nvars 
     394      nvars = iom_nf90_nvars( idnum ) 
     395      IF(lwp) write(numout, *) 'File ', TRIM(fname), ' NVARS = ',nvars 
     396      DO jv = 1, nvars 
     397         varname = iom_nf90_vname(idnum, jv) 
     398 
    402399         lmeta = .FALSE. 
    403          CALL iom_nf90_check( nf90_inquire_variable(iom_file(idnum)%nfid, jv, varname, xtype, ndims, dimids, natts ), clinfo ) 
    404400         DO i = 1, NMETA 
    405401           IF(varname == meta(i)) THEN 
    406              lmeta = .TRUE. 
     402               lmeta = .TRUE.  
     403               CYCLE 
    407404           ENDIF 
    408405         ENDDO 
    409          IF(.NOT.lmeta) THEN 
    410             CALL xios_add_child(file_hdl, field_hdl, varname) 
    411             mdims = ndims 
    412  
    413             IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN 
    414                mdims = mdims - 1 
    415             ENDIF 
    416  
    417             IF(mdims == 3) THEN 
    418                CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname,   & 
    419                                    domain_ref="grid_N",                           & 
    420                                    axis_ref=iom_axis(indimlens(dimids(mdims))),   & 
    421                                    prec = 8, operation = "instant"                ) 
    422             ELSEIF(mdims == 2) THEN 
    423                CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname,  & 
    424                                    domain_ref="grid_N", prec = 8,                & 
    425                                    operation = "instant"                         ) 
    426             ELSEIF(mdims == 1) THEN 
    427                CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 
    428                                    axis_ref=iom_axis(indimlens(dimids(mdims))), & 
    429                                    prec = 8, operation = "instant"              ) 
    430             ELSEIF(mdims == 0) THEN 
    431                CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 
    432                                    scalar_ref = "grid_scalar", prec = 8,        & 
    433                                    operation = "instant"                        ) 
    434             ELSE 
    435                WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 
    436                CALL ctl_stop( 'iom_set_vars_active:', ctmp1 ) 
    437             ENDIF 
    438          ENDIF 
     406 
     407         IF(lmeta) CYCLE 
     408 
     409         ivid = iom_varid ( idnum, varname, kdimsz = indimlens, kndims = mdims, lduld = lud, ldstop = .TRUE.) 
     410         IF(lud) mdims = mdims - 1 
     411 
     412         CALL xios_add_child(file_hdl, field_hdl, varname) 
     413 
     414         IF(mdims == 3) THEN 
     415           CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname,   & 
     416                               domain_ref="grid_N",                           & 
     417                               axis_ref=iom_axis(indimlens(mdims)),   & 
     418                               prec = 8, operation = "instant"                ) 
     419         ELSEIF(mdims == 2) THEN 
     420           CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname,  & 
     421                               domain_ref="grid_N", prec = 8,                & 
     422                               operation = "instant"                         ) 
     423         ELSEIF(mdims == 1) THEN 
     424           CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 
     425                               axis_ref=iom_axis(indimlens(mdims)), & 
     426                               prec = 8, operation = "instant"              ) 
     427         ELSEIF(mdims == 0) THEN 
     428           CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 
     429                               scalar_ref = "grid_scalar", prec = 8,        & 
     430                               operation = "instant"                        ) 
     431         ELSE 
     432           WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 
     433           CALL ctl_stop( 'iom_set_vars_active:', ctmp1 ) 
     434         ENDIF 
     435         IF(lwp) write(numout, *) 'Variable ', TRIM(varname) ,' active in XIOS context' 
    439436      ENDDO 
    440       DEALLOCATE(indimlens, indimnames) 
    441437#endif 
    442438   END SUBROUTINE iom_set_vars_active 
     
    632628 
    633629      cdcont = "NONE" 
    634  
     630!read restart 
    635631      IF(lrxios) THEN 
    636632         IF(kdid == numror) THEN 
     
    642638         ELSEIF(kdid == numrsr) THEN 
    643639            cdcont = cr_sedrst_cxt 
    644          ENDIF 
    645       ENDIF 
    646  
     640         ELSEIF(kdid == numdom) THEN 
     641            cdcont = cr_dom_cxt 
     642         ENDIF 
     643      ENDIF 
     644!write restart 
    647645      IF(lwxios) THEN 
    648646         IF(kdid == numrow) THEN 
     
    654652         ELSEIF(kdid == numrsw) THEN 
    655653            cdcont = cw_sedrst_cxt 
     654         ENDIF 
     655      ENDIF 
     656!read other than restart files 
     657      IF(ln_xios_read) THEN 
     658         IF(kdid == numdom) THEN 
     659            cdcont = cr_dom_cxt 
    656660         ENDIF 
    657661      ENDIF 
     
    956960      ELSE 
    957961#if defined key_xios 
    958          IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 
     962         IF(lwp) WRITE(numout,*) 'XIOS READ (0D): ', trim(cdvar) 
    959963         CALL iom_swap(context) 
    960964         CALL xios_recv_field( trim(cdvar), pvar) 
    961          CALL iom_swap(cxios_context) 
     965         IF(context /= cr_dom_cxt) CALL iom_swap(cxios_context) 
    962966#else 
    963967         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 
     
    10041008      ELSE 
    10051009#if defined key_xios 
    1006          IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 
     1010         IF(lwp) WRITE(numout,*) 'XIOS READ (0D): ', trim(cdvar) 
    10071011         CALL iom_swap(context) 
    10081012         CALL xios_recv_field( trim(cdvar), pvar) 
    1009          CALL iom_swap(cxios_context) 
     1013         IF(context /= cr_dom_cxt) CALL iom_swap(cxios_context) 
    10101014#else 
    10111015         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 
     
    13771381 
    13781382         IF( PRESENT(pv_r3d) ) THEN 
    1379             IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 
     1383            IF(lwp) WRITE(numout,*) 'XIOS READ (3D): ',TRIM(cdvar) 
    13801384            CALL xios_recv_field( trim(cdvar), pv_r3d(:, :, :)) 
    13811385            IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 
     
    13831387            ENDIF 
    13841388         ELSEIF( PRESENT(pv_r2d) ) THEN 
    1385             IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 
     1389            IF(lwp) WRITE(numout,*) 'XIOS READ (2D): ', TRIM(cdvar) 
    13861390            CALL xios_recv_field( trim(cdvar), pv_r2d(:, :)) 
    13871391            IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 
     
    13891393            ENDIF 
    13901394         ELSEIF( PRESENT(pv_r1d) ) THEN 
    1391             IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 
     1395            IF(lwp) WRITE(numout,*) 'XIOS READ (1D): ', TRIM(cdvar) 
    13921396            CALL xios_recv_field( trim(cdvar), pv_r1d) 
    13931397         ENDIF 
    1394          CALL iom_swap(cxios_context) 
     1398         IF(context /= cr_dom_cxt) CALL iom_swap(cxios_context) 
    13951399#else 
    13961400         istop = istop + 1 
     
    14311435#endif 
    14321436   END SUBROUTINE iom_get_var 
     1437 
     1438   SUBROUTINE iom_dom_context(fdname, numr)   
     1439      !!----------------------------------------------------------------------- 
     1440      !!                  ***  SUBROUTINE  iom_dom_context  *** 
     1441      !! 
     1442      !! ** Purpose : initialize context for reading domain information 
     1443      !!----------------------------------------------------------------------- 
     1444      CHARACTER(len=*), INTENT(IN)         :: fdname 
     1445      INTEGER,          INTENT(IN)         :: numr 
     1446      !local variables 
     1447      CHARACTER(len=lc)                    :: cxname 
     1448      CHARACTER(len=lc)                    :: cfile 
     1449      TYPE(xios_domaingroup)               :: domaingroup_hdl  
     1450      TYPE(xios_domain)                    :: domain_hdl  
     1451      TYPE(xios_axisgroup)                 :: axisgroup_hdl  
     1452      TYPE(xios_axis)                      :: axis_hdl  
     1453      TYPE(xios_scalar)                    :: scalar_hdl  
     1454      TYPE(xios_scalargroup)               :: scalargroup_hdl  
     1455      TYPE(xios_field) :: field_hdl 
     1456      TYPE(xios_file) :: file_hdl 
     1457      TYPE(xios_filegroup) :: filegroup_hdl 
     1458      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0) 
     1459      !!----------------------------------------------------------------------- 
     1460 
     1461#if defined key_xios 
     1462      cxname = cr_dom_cxt 
     1463      IF( TRIM(Agrif_CFixed()) .NE. '0' ) THEN 
     1464         CALL xios_context_initialize(TRIM(Agrif_CFixed())//"_"//TRIM(cxname), mpi_comm_oce) 
     1465      ELSE 
     1466         CALL xios_context_initialize(TRIM(cxname), mpi_comm_oce) 
     1467      ENDIF 
     1468      CALL iom_swap( cxname ) 
     1469!calendar must be defined always 
     1470      CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1,1,1,00,00,00), & 
     1471          &                                    start_date = xios_date(1,1,1,0,0,0) ) 
     1472      CALL xios_get_handle("domain_definition",domaingroup_hdl)  
     1473      CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")  
     1474      ! 
     1475      CALL iom_set_domain_attr("grid_N", ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 
     1476      CALL iom_set_domain_attr("grid_N", data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj) 
     1477 
     1478      CALL xios_get_handle("axis_definition",axisgroup_hdl)  
     1479      CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev")  
     1480!AGRIF fails to compile when unit= is in call to xios_set_axis_attr 
     1481!     CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 
     1482      CALL xios_set_axis_attr ("nav_lev", n_glo=jpk ) 
     1483 
     1484      CALL xios_get_handle("scalar_definition", scalargroup_hdl)  
     1485      CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar")  
     1486 
     1487      IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
     1488         cfile = TRIM(fdname) 
     1489      ELSE 
     1490         cfile = TRIM(Agrif_CFixed())//"_"//TRIM(fdname) 
     1491      ENDIF 
     1492      CALL iom_set_vars_active(numr) 
     1493      ! set time step length 
     1494      dtime%second = rn_Dt 
     1495      CALL xios_set_timestep( dtime ) 
     1496      IF(lwp) write(numout, *) 'Before CLOSE dom_context definition' 
     1497      IF(lwp) CALL flush(numout) 
     1498      CALL iom_init_closedef 
     1499      IF(lwp) write(numout, *) 'CLOSE dom_context definition' 
     1500      IF(lwp) CALL flush(numout) 
     1501#endif 
     1502   END SUBROUTINE iom_dom_context 
    14331503 
    14341504 
     
    22812351      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 
    22822352      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj) 
    2283 !don't define lon and lat for restart reading context. 
     2353!don't define lon and lat for xios reading context. 
    22842354      IF ( .NOT.ldrxios ) & 
    22852355         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp),   & 
Note: See TracChangeset for help on using the changeset viewer.