Ignore:
Timestamp:
08/31/12 15:41:37 (12 years ago)
Author:
cholod
Message:

Load NEMO_TMP into vendor/nemo/current.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • vendor/nemo/current/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r4 r44  
    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 
    … …  
    7473   !!---------------------------------------------------------------------- 
    7574   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    76    !! $Id: iom.F90 3294 2012-01-28 16:44:18Z rblod $ 
     75   !! $Id: iom.F90 3415 2012-06-15 13:29:37Z rblod $ 
    7776   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    7877   !!---------------------------------------------------------------------- 
    … …  
    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      !!---------------------------------------------------------------------- 
     92 
     93      CALL xios_context_initialize("nemo", mpi_comm_opa) 
    9494      CALL iom_swap 
    9595 
    9696      ! calendar parameters 
    9797      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'     ) 
     98      CASE ( 1)   ;   CALL xios_set_context_attr("nemo", calendar_type= "Gregorian") 
     99      CASE ( 0)   ;   CALL xios_set_context_attr("nemo", calendar_type= "NoLeap") 
     100      CASE (30)   ;   CALL xios_set_context_attr("nemo", calendar_type= "D360") 
    101101      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 ) 
     102      WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday  
     103      CALL xios_set_context_attr("nemo", start_date=cldate ) 
    105104 
    106105      ! horizontal grid definition 
    107106      CALL set_scalar 
    108       CALL set_grid( "grid_T", glamt, gphit ) 
     107      CALL set_grid( "grid_T", glamt, gphit )  
    109108      CALL set_grid( "grid_U", glamu, gphiu ) 
    110109      CALL set_grid( "grid_V", glamv, gphiv ) 
    … …  
    112111 
    113112      ! 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 ) 
    118 # if defined key_floats 
    119       CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp)  ) 
    120 # endif 
     113      CALL xios_set_axis_attr("deptht",size=size(gdept_0),value=gdept_0) 
     114      CALL xios_set_axis_attr("depthu",size=size(gdept_0),value=gdept_0) 
     115      CALL xios_set_axis_attr("depthv",size=size(gdept_0),value=gdept_0) 
     116      CALL xios_set_axis_attr("depthw",size=size(gdepw_0),value=gdepw_0) 
    121117       
    122118      ! automatic definitions of some of the xml attributs 
    … …  
    124120 
    125121      ! end file definition 
    126       CALL event__close_io_definition 
     122       dtime%second=rdt 
     123       CALL xios_set_timestep(dtime) 
     124       CALL xios_close_context_definition() 
     125 
     126       CALL xios_update_calendar(0) 
    127127#endif 
    128128 
    … …  
    137137      !!--------------------------------------------------------------------- 
    138138#if defined key_iomput 
     139      TYPE(xios_context) :: nemo_hdl 
    139140 
    140141     IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    141         CALL event__swap_context("nemo") 
     142        CALL xios_get_handle("nemo",nemo_hdl) 
    142143     ELSE 
    143         CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo") 
     144        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_nemo",nemo_hdl) 
    144145     ENDIF 
     146     CALL xios_set_current_context(nemo_hdl) 
    145147 
    146148#endif 
    … …  
    339341      INTEGER ::   i_s, i_e   ! temporary integer 
    340342      CHARACTER(LEN=100)    ::   clinfo    ! info character 
     343      INTEGER :: inb_period_initial, inb_period_final, inb_period_sec, inb_period_max, inb_period 
    341344      !--------------------------------------------------------------------- 
    342345      ! 
    … …  
    349352         i_e = jpmax_files 
    350353#if defined key_iomput 
    351          CALL event__stop_ioserver 
     354         CALL xios_context_finalize() 
    352355#endif 
    353356      ENDIF 
    … …  
    960963      REAL(wp)        , INTENT(in) ::   pfield0d 
    961964#if defined key_iomput 
    962       CALL event__write_field2D( cdname, RESHAPE( (/pfield0d/), (/1,1/) ) ) 
     965      CALL xios_send_field(cdname, (/pfield0d/)) 
    963966#else 
    964967      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    … …  
    969972      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
    970973      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d 
    971       INTEGER :: jpz 
    972974#if defined key_iomput 
    973       jpz=SIZE(pfield1d) 
    974       CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) ) 
     975      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
    975976#else 
    976977      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
    … …  
    982983      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    983984#if defined key_iomput 
    984       CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 
     985      CALL xios_send_field(cdname, pfield2d) 
    985986#else 
    986987      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    … …  
    992993      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    993994#if defined key_iomput 
    994       CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 
     995      CALL xios_send_field(cdname, pfield3d) 
    995996#else 
    996997      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    … …  
    10021003#if defined key_iomput 
    10031004 
     1005   SUBROUTINE iom_set_domain_attr( cdname, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   & 
     1006      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue ) 
     1007      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     1008      INTEGER               , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
     1009      INTEGER               , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
     1010      INTEGER               , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 
     1011      REAL(wp), DIMENSION(:), OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
     1012 
     1013      IF ( xios_is_valid_domain(TRIM(cdname)) ) THEN 
     1014         CALL xios_set_domain_attr( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj  ,   & 
     1015            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj,   & 
     1016            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                      & 
     1017            &    lonvalue=lonvalue, latvalue=latvalue ) 
     1018      ENDIF 
     1019 
     1020      IF ( xios_is_valid_domaingroup(TRIM(cdname)) ) THEN 
     1021         CALL xios_set_domaingroup_attr( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     1022            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj   ,   & 
     1023            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                         & 
     1024            &    lonvalue=lonvalue, latvalue=latvalue ) 
     1025      ENDIF 
     1026 
     1027   END SUBROUTINE iom_set_domain_attr 
     1028 
     1029 
     1030   SUBROUTINE iom_set_field_attr( cdname, freq_op) 
     1031      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
     1032      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op 
     1033 
     1034      IF ( xios_is_valid_field(TRIM(cdname)) ) THEN 
     1035         CALL xios_set_field_attr( cdname, freq_op=freq_op ) 
     1036      ENDIF 
     1037      IF ( xios_is_valid_fieldgroup(TRIM(cdname)) ) THEN 
     1038         CALL xios_set_fieldgroup_attr( cdname, freq_op=freq_op ) 
     1039      ENDIF 
     1040 
     1041   END SUBROUTINE iom_set_field_attr 
     1042 
     1043 
     1044   SUBROUTINE iom_set_file_attr( cdname, name, name_suffix ) 
     1045      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
     1046      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix 
     1047 
     1048      IF ( xios_is_valid_file(TRIM(cdname)) ) THEN 
     1049         CALL xios_set_file_attr( cdname, name=name, name_suffix=name_suffix ) 
     1050      ENDIF 
     1051      IF ( xios_is_valid_filegroup(TRIM(cdname)) ) THEN 
     1052         CALL xios_set_filegroup_attr( cdname, name=name, name_suffix=name_suffix ) 
     1053      ENDIF 
     1054 
     1055   END SUBROUTINE iom_set_file_attr 
     1056 
     1057 
    10041058   SUBROUTINE set_grid( cdname, plon, plat ) 
    10051059      !!---------------------------------------------------------------------- 
    … …  
    10121066      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon 
    10131067      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  
     1068      INTEGER  :: ni,nj 
     1069       
     1070      ni=nlei-nldi+1 ; nj=nlej-nldj+1 
     1071 
     1072      CALL iom_set_domain_attr(cdname, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
     1073      CALL iom_set_domain_attr(cdname, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     1074      CALL iom_set_domain_attr(cdname, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
     1075         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))    
     1076       
    10201077   END SUBROUTINE set_grid 
    10211078 
    … …  
    10301087      REAL(wp), DIMENSION(1,1) ::   zz = 1. 
    10311088      !!---------------------------------------------------------------------- 
    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' ) 
     1089      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
     1090      CALL iom_set_domain_attr('scalarpoint', data_dim=1) 
     1091      CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /)) 
    10351092 
    10361093   END SUBROUTINE set_scalar 
    … …  
    10491106      CHARACTER(len=1)               ::   cl1                      ! 1 character 
    10501107      CHARACTER(len=2)               ::   cl2                      ! 1 character 
     1108      CHARACTER(len=255)             ::   tfo 
    10511109      INTEGER                        ::   idt                      ! time-step in seconds 
    10521110      INTEGER                        ::   iddss, ihhss             ! number of seconds in 1 day, 1 hour and 1 year 
    … …  
    10681126 
    10691127      ! 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        
     1128      tfo = TRIM(i2str(idt))//'s' 
     1129      CALL iom_set_field_attr('field_definition', freq_op=tfo) 
     1130      CALL iom_set_field_attr('SBC', freq_op=TRIM(i2str(idt* nn_fsbc))//'s') 
     1131        
    10731132      ! output file names (attribut: name) 
    10741133      clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /)       
    … …  
    10781137               WRITE(cl2,'(i2)') jh  
    10791138               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) ) ) 
     1139               CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), name=TRIM(clname)) 
    10811140            ENDIF 
    10821141         END DO 
    … …  
    10841143            WRITE(cl1,'(i1)') jd  
    10851144            CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. ) 
    1086             CALL event__set_attribut( cl1//'d_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1145            CALL iom_set_file_attr(cl1//'d_'//clsuff(jg), name=TRIM(clname)) 
    10871146         END DO 
    10881147         DO jm = 1, 6                                                                          ! 1, 2, 3, 4, 6 months 
    … …  
    10901149               WRITE(cl1,'(i1)') jm  
    10911150               CALL dia_nam( clname, -jm, clsuff(jg) ) 
    1092                CALL event__set_attribut( cl1//'m_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1151               CALL iom_set_file_attr(cl1//'m_'//clsuff(jg), name=TRIM(clname)) 
    10931152            ENDIF 
    10941153         END DO 
    … …  
    10971156               WRITE(cl2,'(i2)') jy  
    10981157               CALL dia_nam( clname, -jy * iyymo, clsuff(jg) ) 
    1099                CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1158               CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), name=TRIM(clname)) 
    11001159            ENDIF 
    11011160         END DO 
    … …  
    11081167         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    11091168         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'  ) ) 
     1169         CALL iom_set_domain_attr('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 
     1170         CALL iom_set_file_attr('Eq'//cl1, name_suffix= '_Eq') 
    11131171      END DO 
    11141172      ! TAO moorings (attributs: ibegin, jbegin, name_suffix) 
    … …  
    11851243               ENDIF 
    11861244               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) ) )       
     1245               CALL iom_set_domain_attr(TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 
     1246               CALL iom_set_file_attr(TRIM(clname)//cl1, name_suffix= '_'//TRIM(clname)) 
    11901247            END DO 
    11911248         END DO 
    … …  
    12031260#endif 
    12041261 
    1205  
     1262   FUNCTION i2str(int) 
     1263   IMPLICIT NONE 
     1264      INTEGER, INTENT(IN) :: int 
     1265      CHARACTER(LEN=255) :: i2str 
     1266 
     1267      WRITE(i2str,*) int 
     1268       
     1269   END FUNCTION i2str   
     1270    
    12061271   !!====================================================================== 
    12071272END MODULE iom 
Note: See TracChangeset for help on using the changeset viewer.