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 3695 for branches/2012/dev_MERGE_2012/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2012-11-28T09:46:30+01:00 (11 years ago)
Author:
smasson
Message:

dev_MERGE_2012: add xios

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r3294 r3695  
    3232   USE phycst          ! physical constants 
    3333   USE dianam          ! build name of file 
    34    USE mod_event_client 
    35    USE mod_attribut 
     34   USE xios 
    3635# endif 
    3736 
    … …  
    5150   PRIVATE iom_p1d, iom_p2d, iom_p3d 
    5251#if defined key_iomput 
    53    PRIVATE set_grid 
     52   PRIVATE iom_set_domain_attr, iom_set_field_attr, iom_set_file_attr, set_grid, set_scalar, set_xmlatt, set_mooring 
    5453# endif 
    5554 
    … …  
    6867#if defined key_iomput 
    6968   INTERFACE iom_setkt 
    70       MODULE PROCEDURE event__set_timestep 
     69      MODULE PROCEDURE xios_update_calendar 
    7170   END INTERFACE 
    7271# endif 
    … …  
    8887      !!---------------------------------------------------------------------- 
    8988#if defined key_iomput 
    90       REAL(wp) ::   ztmp 
    91       !!---------------------------------------------------------------------- 
    92       ! read the xml file 
    93       IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)... 
     89      TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0) 
     90      CHARACTER(len=19) :: cldate  
     91      INTEGER           ::   ji 
     92      !!---------------------------------------------------------------------- 
     93 
     94      CALL xios_context_initialize("nemo", mpi_comm_opa) 
    9495      CALL iom_swap 
    9596 
    9697      ! calendar parameters 
    9798      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    98       CASE ( 1)   ;   CALL event__set_calendar('gregorian') 
    99       CASE ( 0)   ;   CALL event__set_calendar('noleap'   ) 
    100       CASE (30)   ;   CALL event__set_calendar('360d'     ) 
     99      CASE ( 1)   ;   CALL xios_set_context_attr("nemo", calendar_type= "Gregorian") 
     100      CASE ( 0)   ;   CALL xios_set_context_attr("nemo", calendar_type= "NoLeap") 
     101      CASE (30)   ;   CALL xios_set_context_attr("nemo", calendar_type= "D360") 
    101102      END SELECT 
    102       ztmp = fjulday - adatrj 
    103       IF( ABS(ztmp  - REAL(NINT(ztmp),wp)) < 0.1 / rday )   ztmp = REAL(NINT(ztmp),wp)   ! avoid truncation error 
    104       CALL event__set_time_parameters( nit000 - 1, ztmp, rdt ) 
     103      WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday  
     104      CALL xios_set_context_attr("nemo", start_date=cldate ) 
    105105 
    106106      ! horizontal grid definition 
    107107      CALL set_scalar 
    108       CALL set_grid( "grid_T", glamt, gphit ) 
     108      CALL set_grid( "grid_T", glamt, gphit )  
    109109      CALL set_grid( "grid_U", glamu, gphiu ) 
    110110      CALL set_grid( "grid_V", glamv, gphiv ) 
    … …  
    112112 
    113113      ! vertical grid definition 
    114       CALL event__set_vert_axis( "deptht", gdept_0 ) 
    115       CALL event__set_vert_axis( "depthu", gdept_0 ) 
    116       CALL event__set_vert_axis( "depthv", gdept_0 ) 
    117       CALL event__set_vert_axis( "depthw", gdepw_0 ) 
     114      CALL xios_set_axis_attr("deptht",size=size(gdept_0),value=gdept_0) 
     115      CALL xios_set_axis_attr("depthu",size=size(gdept_0),value=gdept_0) 
     116      CALL xios_set_axis_attr("depthv",size=size(gdept_0),value=gdept_0) 
     117      CALL xios_set_axis_attr("depthw",size=size(gdepw_0),value=gdepw_0) 
    118118# if defined key_floats 
    119       CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp)  ) 
     119      CALL xios_set_axis_attr("nfloat",size=nfloat,value=(ji, ji=1,nfloat)) 
    120120# endif 
    121121       
    … …  
    124124 
    125125      ! end file definition 
    126       CALL event__close_io_definition 
     126       dtime%second=rdt 
     127       CALL xios_set_timestep(dtime) 
     128       CALL xios_close_context_definition() 
     129 
     130       CALL xios_update_calendar(0) 
    127131#endif 
    128132 
    … …  
    137141      !!--------------------------------------------------------------------- 
    138142#if defined key_iomput 
     143      TYPE(xios_context) :: nemo_hdl 
    139144 
    140145     IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    141         CALL event__swap_context("nemo") 
     146        CALL xios_get_handle("nemo",nemo_hdl) 
    142147     ELSE 
    143         CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo") 
     148        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_nemo",nemo_hdl) 
    144149     ENDIF 
     150     CALL xios_set_current_context(nemo_hdl) 
    145151 
    146152#endif 
    … …  
    349355         i_e = jpmax_files 
    350356#if defined key_iomput 
    351          CALL event__stop_ioserver 
     357         CALL xios_context_finalize() 
    352358#endif 
    353359      ENDIF 
    … …  
    960966      REAL(wp)        , INTENT(in) ::   pfield0d 
    961967#if defined key_iomput 
    962       CALL event__write_field2D( cdname, RESHAPE( (/pfield0d/), (/1,1/) ) ) 
     968      CALL xios_send_field(cdname, (/pfield0d/)) 
    963969#else 
    964970      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    … …  
    969975      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
    970976      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d 
    971       INTEGER :: jpz 
    972977#if defined key_iomput 
    973       jpz=SIZE(pfield1d) 
    974       CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) ) 
     978      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
    975979#else 
    976980      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
    … …  
    982986      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    983987#if defined key_iomput 
    984       CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 
     988      CALL xios_send_field(cdname, pfield2d) 
    985989#else 
    986990      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    … …  
    992996      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    993997#if defined key_iomput 
    994       CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 
     998      CALL xios_send_field(cdname, pfield3d) 
    995999#else 
    9961000      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    … …  
    10021006#if defined key_iomput 
    10031007 
     1008   SUBROUTINE iom_set_domain_attr( cdname, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   & 
     1009      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue ) 
     1010      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     1011      INTEGER               , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
     1012      INTEGER               , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
     1013      INTEGER               , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 
     1014      REAL(wp), DIMENSION(:), OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
     1015 
     1016      IF ( xios_is_valid_domain(TRIM(cdname)) ) THEN 
     1017         CALL xios_set_domain_attr( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj  ,   & 
     1018            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj,   & 
     1019            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                      & 
     1020            &    lonvalue=lonvalue, latvalue=latvalue ) 
     1021      ENDIF 
     1022 
     1023      IF ( xios_is_valid_domaingroup(TRIM(cdname)) ) THEN 
     1024         CALL xios_set_domaingroup_attr( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     1025            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj   ,   & 
     1026            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                         & 
     1027            &    lonvalue=lonvalue, latvalue=latvalue ) 
     1028      ENDIF 
     1029 
     1030   END SUBROUTINE iom_set_domain_attr 
     1031 
     1032 
     1033   SUBROUTINE iom_set_field_attr( cdname, freq_op) 
     1034      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
     1035      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op 
     1036 
     1037      IF ( xios_is_valid_field(TRIM(cdname)) ) THEN 
     1038         CALL xios_set_field_attr( cdname, freq_op=freq_op ) 
     1039      ENDIF 
     1040      IF ( xios_is_valid_fieldgroup(TRIM(cdname)) ) THEN 
     1041         CALL xios_set_fieldgroup_attr( cdname, freq_op=freq_op ) 
     1042      ENDIF 
     1043 
     1044   END SUBROUTINE iom_set_field_attr 
     1045 
     1046 
     1047   SUBROUTINE iom_set_file_attr( cdname, name, name_suffix ) 
     1048      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
     1049      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix 
     1050 
     1051      IF ( xios_is_valid_file(TRIM(cdname)) ) THEN 
     1052         CALL xios_set_file_attr( cdname, name=name, name_suffix=name_suffix ) 
     1053      ENDIF 
     1054      IF ( xios_is_valid_filegroup(TRIM(cdname)) ) THEN 
     1055         CALL xios_set_filegroup_attr( cdname, name=name, name_suffix=name_suffix ) 
     1056      ENDIF 
     1057 
     1058   END SUBROUTINE iom_set_file_attr 
     1059 
     1060 
    10041061   SUBROUTINE set_grid( cdname, plon, plat ) 
    10051062      !!---------------------------------------------------------------------- 
    … …  
    10121069      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon 
    10131070      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    1014  
    1015       CALL event__set_grid_dimension( cdname, jpiglo, jpjglo) 
    1016       CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, & 
    1017          &                         plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) ) 
    1018       CALL event__set_grid_type_nemo( cdname ) 
    1019  
     1071      INTEGER  :: ni,nj 
     1072       
     1073      ni=nlei-nldi+1 ; nj=nlej-nldj+1 
     1074 
     1075      CALL iom_set_domain_attr(cdname, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
     1076      CALL iom_set_domain_attr(cdname, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     1077      CALL iom_set_domain_attr(cdname, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
     1078         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))    
     1079       
    10201080   END SUBROUTINE set_grid 
    10211081 
    … …  
    10301090      REAL(wp), DIMENSION(1,1) ::   zz = 1. 
    10311091      !!---------------------------------------------------------------------- 
    1032       CALL event__set_grid_dimension( 'scalarpoint', jpnij, 1) 
    1033       CALL event__set_grid_domain   ( 'scalarpoint', 1, 1, narea, 1, zz, zz ) 
    1034       CALL event__set_grid_type_nemo( 'scalarpoint' ) 
     1092      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
     1093      CALL iom_set_domain_attr('scalarpoint', data_dim=1) 
     1094      CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /)) 
    10351095 
    10361096   END SUBROUTINE set_scalar 
    … …  
    10491109      CHARACTER(len=1)               ::   cl1                      ! 1 character 
    10501110      CHARACTER(len=2)               ::   cl2                      ! 1 character 
     1111      CHARACTER(len=255)             ::   tfo 
    10511112      INTEGER                        ::   idt                      ! time-step in seconds 
    10521113      INTEGER                        ::   iddss, ihhss             ! number of seconds in 1 day, 1 hour and 1 year 
    … …  
    10681129 
    10691130      ! frequency of the call of iom_put (attribut: freq_op) 
    1070       CALL event__set_attribut( 'field_definition', attr( field__freq_op, idt           ) )    ! model time-step 
    1071       CALL event__set_attribut( 'SBC'             , attr( field__freq_op, idt * nn_fsbc ) )    ! SBC time-step 
    1072        
     1131      tfo = TRIM(i2str(idt))//'s' 
     1132      CALL iom_set_field_attr('field_definition', freq_op=tfo) 
     1133      CALL iom_set_field_attr('SBC', freq_op=TRIM(i2str(idt* nn_fsbc))//'s') 
     1134        
    10731135      ! output file names (attribut: name) 
    10741136      clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /)       
    … …  
    10781140               WRITE(cl2,'(i2)') jh  
    10791141               CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. ) 
    1080                CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1142               CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), name=TRIM(clname)) 
    10811143            ENDIF 
    10821144         END DO 
    … …  
    10841146            WRITE(cl1,'(i1)') jd  
    10851147            CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. ) 
    1086             CALL event__set_attribut( cl1//'d_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1148            CALL iom_set_file_attr(cl1//'d_'//clsuff(jg), name=TRIM(clname)) 
    10871149         END DO 
    10881150         DO jm = 1, 6                                                                          ! 1, 2, 3, 4, 6 months 
    … …  
    10901152               WRITE(cl1,'(i1)') jm  
    10911153               CALL dia_nam( clname, -jm, clsuff(jg) ) 
    1092                CALL event__set_attribut( cl1//'m_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1154               CALL iom_set_file_attr(cl1//'m_'//clsuff(jg), name=TRIM(clname)) 
    10931155            ENDIF 
    10941156         END DO 
    … …  
    10971159               WRITE(cl2,'(i2)') jy  
    10981160               CALL dia_nam( clname, -jy * iyymo, clsuff(jg) ) 
    1099                CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1161               CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), name=TRIM(clname)) 
    11001162            ENDIF 
    11011163         END DO 
    … …  
    11081170         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    11091171         CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
    1110          CALL event__set_attribut( 'Eq'//cl1, attr( zoom__jbegin     , iy     ) ) 
    1111          CALL event__set_attribut( 'Eq'//cl1, attr( zoom__ni         , jpiglo ) ) 
    1112          CALL event__set_attribut( 'Eq'//cl1, attr( file__name_suffix, '_Eq'  ) ) 
     1172         CALL iom_set_domain_attr('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 
     1173         CALL iom_set_file_attr('Eq'//cl1, name_suffix= '_Eq') 
    11131174      END DO 
    11141175      ! TAO moorings (attributs: ibegin, jbegin, name_suffix) 
    … …  
    11851246               ENDIF 
    11861247               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 
    1187                CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__ibegin     , ix                ) ) 
    1188                CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__jbegin     , iy                ) ) 
    1189                CALL event__set_attribut( TRIM(clname)//cl1, attr( file__name_suffix, '_'//TRIM(clname) ) )       
     1248               CALL iom_set_domain_attr(TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 
     1249               CALL iom_set_file_attr(TRIM(clname)//cl1, name_suffix= '_'//TRIM(clname)) 
    11901250            END DO 
    11911251         END DO 
    … …  
    12031263#endif 
    12041264 
    1205  
     1265   FUNCTION i2str(int) 
     1266   IMPLICIT NONE 
     1267      INTEGER, INTENT(IN) :: int 
     1268      CHARACTER(LEN=255) :: i2str 
     1269 
     1270      WRITE(i2str,*) int 
     1271       
     1272   END FUNCTION i2str   
     1273    
    12061274   !!====================================================================== 
    12071275END MODULE iom 
Note: See TracChangeset for help on using the changeset viewer.