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 6736 for branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 – NEMO

Ignore:
Timestamp:
2016-06-24T09:50:27+02:00 (8 years ago)
Author:
jamesharle
Message:

FASTNEt code modifications

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r3771 r6736  
    77   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO 
    88   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime 
    9    !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case   
     9   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case  
     10   !!            3.4  ! 2013-04  (J. Harle)  added real attribute case  
    1011   !!-------------------------------------------------------------------- 
    1112 
    … …  
    3031#if defined key_iomput 
    3132   USE sbc_oce, ONLY :   nn_fsbc         ! ocean space and time domain 
    32    USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
    3333   USE domngb          ! ocean space and time domain 
    3434   USE phycst          ! physical constants 
    3535   USE dianam          ! build name of file 
    36    USE xios 
     36   USE mod_event_client 
     37   USE mod_attribut 
    3738# endif 
    3839 
    … …  
    5253   PRIVATE iom_p1d, iom_p2d, iom_p3d 
    5354#if defined key_iomput 
    54    PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_set_grid_attr 
    55    PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring 
     55   PRIVATE set_grid 
    5656# endif 
    5757 
    … …  
    6060   END INTERFACE 
    6161   INTERFACE iom_getatt 
    62       MODULE PROCEDURE iom_g0d_intatt 
     62      MODULE PROCEDURE iom_g0d_intatt, iom_g0d_ratt 
    6363   END INTERFACE 
    6464   INTERFACE iom_rstput 
    … …  
    7070#if defined key_iomput 
    7171   INTERFACE iom_setkt 
    72       MODULE PROCEDURE xios_update_calendar 
     72      MODULE PROCEDURE event__set_timestep 
    7373   END INTERFACE 
    7474# endif 
    … …  
    9090      !!---------------------------------------------------------------------- 
    9191#if defined key_iomput 
    92       TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0) 
    93       CHARACTER(len=19) :: cldate  
    94       CHARACTER(len=10) :: clname 
    95       INTEGER           ::   ji 
    96       !!---------------------------------------------------------------------- 
    97  
    98       clname = "nemo" 
    99       IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 
    100       CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 
     92      REAL(wp) ::   ztmp 
     93      !!---------------------------------------------------------------------- 
     94!if defined key_adam 
     95!     REAL(wp)        ,DIMENSION( 2833) ::   zlon 
     96!     REAL(wp)        ,DIMENSION( 2833) ::   zlat 
     97!  include "NA_lons.h90"       
     98!  include "NA_lats.h90"       
     99!endif 
     100      ! read the xml file 
     101      IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)... 
    101102      CALL iom_swap 
    102103 
    103104      ! calendar parameters 
    104105      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    105       CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") 
    106       CASE ( 0)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap") 
    107       CASE (30)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360") 
     106      CASE ( 1)   ;   CALL event__set_calendar('gregorian') 
     107      CASE ( 0)   ;   CALL event__set_calendar('noleap'   ) 
     108      CASE (30)   ;   CALL event__set_calendar('360d'     ) 
    108109      END SELECT 
    109       WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday  
    110       CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 
     110      ztmp = fjulday - adatrj 
     111      IF( ABS(ztmp  - REAL(NINT(ztmp),wp)) < 0.1 / rday )   ztmp = REAL(NINT(ztmp),wp)   ! avoid truncation error 
     112      CALL event__set_time_parameters( nit000 - 1, ztmp, rdt ) 
    111113 
    112114      ! horizontal grid definition 
    113115      CALL set_scalar 
    114       CALL set_grid( "T", glamt, gphit )  
    115       CALL set_grid( "U", glamu, gphiu ) 
    116       CALL set_grid( "V", glamv, gphiv ) 
    117       CALL set_grid( "W", glamt, gphit ) 
     116#if defined key_adam 
     117!     CALL set_grid( "grid_A", zlon, zlat ) 
     118      WRITE(*,*) 'A0' 
     119      CALL set_adam_mooring 
     120      WRITE(*,*) 'A1' 
     121#endif 
     122      CALL set_grid( "grid_T", glamt, gphit ) 
     123      CALL set_grid( "grid_U", glamu, gphiu ) 
     124      CALL set_grid( "grid_V", glamv, gphiv ) 
     125      CALL set_grid( "grid_W", glamt, gphit ) 
    118126 
    119127      ! vertical grid definition 
    120       CALL iom_set_axis_attr( "deptht", gdept_0 ) 
    121       CALL iom_set_axis_attr( "depthu", gdept_0 ) 
    122       CALL iom_set_axis_attr( "depthv", gdept_0 ) 
    123       CALL iom_set_axis_attr( "depthw", gdepw_0 ) 
     128      CALL event__set_vert_axis( "deptht", gdept_0 ) 
     129      CALL event__set_vert_axis( "depthu", gdept_0 ) 
     130      CALL event__set_vert_axis( "depthv", gdept_0 ) 
     131      CALL event__set_vert_axis( "depthw", gdepw_0 ) 
    124132# if defined key_floats 
    125       CALL iom_set_axis_attr( "nfloat", (ji, ji=1,nfloat) ) 
     133      CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp) ) 
    126134# endif 
    127135       
    … …  
    130138 
    131139      ! end file definition 
    132        dtime%second=rdt 
    133        CALL xios_set_timestep(dtime) 
    134        CALL xios_close_context_definition() 
    135  
    136        CALL xios_update_calendar(0) 
     140      CALL event__close_io_definition 
    137141#endif 
    138142 
    … …  
    147151      !!--------------------------------------------------------------------- 
    148152#if defined key_iomput 
    149       TYPE(xios_context) :: nemo_hdl 
    150153 
    151154     IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    152         CALL xios_get_handle("nemo",nemo_hdl) 
     155        CALL event__swap_context("nemo") 
    153156     ELSE 
    154         CALL xios_get_handle(TRIM(Agrif_CFixed())//"_nemo",nemo_hdl) 
     157        CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo") 
    155158     ENDIF 
    156      CALL xios_set_current_context(nemo_hdl) 
    157159 
    158160#endif 
    … …  
    360362         i_s = 1 
    361363         i_e = jpmax_files 
     364#if defined key_iomput 
     365         CALL event__stop_ioserver 
     366#endif 
    362367      ENDIF 
    363368 
    … …  
    855860   !!                   INTERFACE iom_getatt 
    856861   !!---------------------------------------------------------------------- 
    857    SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar ) 
     862   SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar, cdvar ) 
    858863      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
    859864      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
    860       INTEGER         , INTENT(  out)                 ::   pvar      ! read field 
     865      INTEGER         , INTENT(  out)                 ::   pvar      ! written field 
     866      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
    861867      ! 
    862868      IF( kiomid > 0 ) THEN 
    … …  
    864870            SELECT CASE (iom_file(kiomid)%iolib) 
    865871            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available') 
    866             CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 
     872            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pv_i0d=pvar ) 
    867873            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available') 
    868874            CASE DEFAULT     
    … …  
    873879   END SUBROUTINE iom_g0d_intatt 
    874880 
     881   SUBROUTINE iom_g0d_ratt( kiomid, cdatt, pvar, cdvar ) 
     882      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     883      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute 
     884      REAL(wp)        , INTENT(  out)                 ::   pvar      ! written field 
     885      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable 
     886      ! 
     887      IF( kiomid > 0 ) THEN 
     888         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     889            SELECT CASE (iom_file(kiomid)%iolib) 
     890            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available') 
     891            CASE (jpnf90   )   ;   IF( PRESENT(cdvar) ) THEN 
     892                                      CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar, cdvar=cdvar ) 
     893                                   ELSE 
     894                                      CALL iom_nf90_getatt( kiomid, cdatt, pv_r0d=pvar ) 
     895                                   ENDIF 
     896            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available') 
     897            CASE DEFAULT     
     898               CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     899            END SELECT 
     900         ENDIF 
     901      ENDIF 
     902   END SUBROUTINE iom_g0d_ratt 
    875903 
    876904   !!---------------------------------------------------------------------- 
    … …  
    9731001      REAL(wp)        , INTENT(in) ::   pfield0d 
    9741002#if defined key_iomput 
    975       CALL xios_send_field(cdname, (/pfield0d/)) 
     1003      CALL event__write_field2D( cdname, RESHAPE( (/pfield0d/), (/1,1/) ) ) 
    9761004#else 
    9771005      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    … …  
    9821010      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
    9831011      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d 
     1012      INTEGER :: jpz 
    9841013#if defined key_iomput 
    985       CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
     1014      jpz=SIZE(pfield1d) 
     1015      CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) ) 
    9861016#else 
    9871017      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
    … …  
    9931023      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    9941024#if defined key_iomput 
    995       CALL xios_send_field(cdname, pfield2d) 
     1025      CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 
    9961026#else 
    9971027      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    … …  
    10031033      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    10041034#if defined key_iomput 
    1005       CALL xios_send_field(cdname, pfield3d) 
     1035      CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 
    10061036#else 
    10071037      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    … …  
    10131043#if defined key_iomput 
    10141044 
    1015    SUBROUTINE iom_set_domain_attr( cdname, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   & 
    1016       &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 
    1017       CHARACTER(LEN=*)                 , INTENT(in) ::   cdname 
    1018       INTEGER                , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj 
    1019       INTEGER                , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    1020       INTEGER                , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 
    1021       REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    1022       LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) ::   mask 
    1023  
    1024       IF ( xios_is_valid_domain     (cdname) ) THEN 
    1025          CALL xios_set_domain_attr     ( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    1026             &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj   ,   & 
    1027             &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                         & 
    1028             &    lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 
    1029       ENDIF 
    1030  
    1031       IF ( xios_is_valid_domaingroup(cdname) ) THEN 
    1032          CALL xios_set_domaingroup_attr( cdname, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
    1033             &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj   ,   & 
    1034             &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                         & 
    1035             &    lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 
    1036       ENDIF 
    1037  
    1038    END SUBROUTINE iom_set_domain_attr 
    1039  
    1040  
    1041    SUBROUTINE iom_set_axis_attr( cdname, paxis ) 
    1042       CHARACTER(LEN=*)      , INTENT(in) ::   cdname 
    1043       REAL(wp), DIMENSION(:), INTENT(in) ::   paxis 
    1044       IF ( xios_is_valid_axis     (cdname) )   CALL xios_set_axis_attr     ( cdname, size=size(paxis),value=paxis ) 
    1045       IF ( xios_is_valid_axisgroup(cdname) )   CALL xios_set_axisgroup_attr( cdname, size=size(paxis),value=paxis ) 
    1046    END SUBROUTINE iom_set_axis_attr 
    1047  
    1048  
    1049    SUBROUTINE iom_set_field_attr( cdname, freq_op) 
    1050       CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
    1051       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op 
    1052       IF ( xios_is_valid_field     (cdname) )   CALL xios_set_field_attr     ( cdname, freq_op=freq_op ) 
    1053       IF ( xios_is_valid_fieldgroup(cdname) )   CALL xios_set_fieldgroup_attr( cdname, freq_op=freq_op ) 
    1054    END SUBROUTINE iom_set_field_attr 
    1055  
    1056  
    1057    SUBROUTINE iom_set_file_attr( cdname, name, name_suffix ) 
    1058       CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
    1059       CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix 
    1060       IF ( xios_is_valid_file     (cdname) )   CALL xios_set_file_attr     ( cdname, name=name, name_suffix=name_suffix ) 
    1061       IF ( xios_is_valid_filegroup(cdname) )   CALL xios_set_filegroup_attr( cdname, name=name, name_suffix=name_suffix ) 
    1062    END SUBROUTINE iom_set_file_attr 
    1063  
    1064  
    1065    SUBROUTINE iom_set_grid_attr( cdname, mask ) 
    1066       CHARACTER(LEN=*)                   , INTENT(in) ::   cdname 
    1067       LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask 
    1068       IF ( xios_is_valid_grid     (cdname) )   CALL xios_set_grid_attr     ( cdname, mask=mask ) 
    1069       IF ( xios_is_valid_gridgroup(cdname) )   CALL xios_set_gridgroup_attr( cdname, mask=mask ) 
    1070    END SUBROUTINE iom_set_grid_attr 
    1071  
    1072  
    1073    SUBROUTINE set_grid( cdgrd, plon, plat ) 
     1045   SUBROUTINE set_grid( cdname, plon, plat ) 
    10741046      !!---------------------------------------------------------------------- 
    10751047      !!                     ***  ROUTINE   *** 
    … …  
    10781050      !! 
    10791051      !!---------------------------------------------------------------------- 
    1080       CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd 
     1052      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    10811053      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon 
    10821054      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    1083       ! 
    1084       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
    1085       INTEGER  :: ni,nj 
    1086        
    1087       ni=nlei-nldi+1 ; nj=nlej-nldj+1 
    1088  
    1089       CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
    1090       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    1091       CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    1092          &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    1093  
    1094       IF ( ln_mskland ) THEN 
    1095          ! mask land points, keep values on coast line -> specific mask for U, V and W points 
    1096          SELECT CASE ( cdgrd ) 
    1097          CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:) 
    1098          CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( zmask, 'U', 1. ) 
    1099          CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpi,:)   ;   CALL lbc_lnk( zmask, 'V', 1. ) 
    1100          CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1) 
    1101          END SELECT 
    1102          ! 
    1103          CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = zmask(:,:,1) /= 0. ) 
    1104          CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = zmask(:,:,:) /= 0. ) 
    1105       ENDIF 
    1106        
     1055 
     1056      CALL event__set_grid_dimension( cdname, jpiglo, jpjglo) 
     1057      CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, & 
     1058         &                         plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) ) 
     1059      CALL event__set_grid_type_nemo( cdname ) 
     1060 
    11071061   END SUBROUTINE set_grid 
    11081062 
    … …  
    11171071      REAL(wp), DIMENSION(1,1) ::   zz = 1. 
    11181072      !!---------------------------------------------------------------------- 
    1119       CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 
    1120       CALL iom_set_domain_attr('scalarpoint', data_dim=1) 
    1121       CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /)) 
     1073      CALL event__set_grid_dimension( 'scalarpoint', jpnij, 1) 
     1074      CALL event__set_grid_domain   ( 'scalarpoint', 1, 1, narea, 1, zz, zz ) 
     1075      CALL event__set_grid_type_nemo( 'scalarpoint' ) 
    11221076 
    11231077   END SUBROUTINE set_scalar 
    11241078 
     1079#if defined key_adam 
     1080 
     1081   SUBROUTINE set_adam_mooring 
     1082      !!---------------------------------------------------------------------- 
     1083      !!                     ***  ROUTINE   *** 
     1084      !! 
     1085      !! ** Purpose :   define fake grids for adam's mooring data 
     1086      !! 
     1087      !!---------------------------------------------------------------------- 
     1088      REAL(wp)        ,DIMENSION( 2833,1) ::   zlon 
     1089      REAL(wp)        ,DIMENSION( 2833,1) ::   zlat 
     1090      INTEGER         ,DIMENSION( 2833,1) ::   ix 
     1091      INTEGER         ,DIMENSION( 2833,1) ::   iy 
     1092      INTEGER                           ::   ji 
     1093      !!---------------------------------------------------------------------- 
     1094#  include "NA_lons.h90"       
     1095#  include "NA_lats.h90"       
     1096      DO ji = 1, 2833 
     1097         CALL dom_ngb( zlon(ji), zlat(ji), ix(ji), iy(ji), 'T' ) 
     1098      ENDDO 
     1099!     WRITE(*,*) 'CLOSEST', narea, ix(1), iy(1), zlon(1), zlat(1) 
     1100      WRITE(*,*) 'a0' 
     1101!     CALL event__set_grid_dimension( 'grid_A', 1, 1) 
     1102      CALL event__set_grid_dimension( 'grid_A', 2833, 1) 
     1103!     CALL event__set_grid_dimension( 'scalarpointX', jpnij, 1) 
     1104      WRITE(*,*) 'a1' 
     1105!     CALL event__set_grid_domain   ( 'grid_A', 1, 1, ix(1), iy(1), zlon(1), zlat(1) ) 
     1106      CALL event__set_grid_domain   ( 'grid_A', 2833, 1, 1, 1, zlon, zlat ) 
     1107!     CALL event__set_grid_domain   ( 'scalarpointX', 1, 1, narea, 1, 1, 1 ) 
     1108      WRITE(*,*) 'a2' 
     1109      CALL event__set_grid_type_nemo( 'grid_A' ) 
     1110!     CALL event__set_grid_type_nemo( 'scalarpointX' ) 
     1111      WRITE(*,*) 'a3' 
     1112              
     1113   END SUBROUTINE set_adam_mooring 
     1114 
     1115#endif 
    11251116 
    11261117   SUBROUTINE set_xmlatt 
    … …  
    11311122      !! 
    11321123      !!---------------------------------------------------------------------- 
     1124#if defined key_adam 
     1125      CHARACTER(len=6),DIMENSION( 9) ::   clsuff                   ! suffix name 
     1126#else 
    11331127      CHARACTER(len=6),DIMENSION( 8) ::   clsuff                   ! suffix name 
     1128#endif 
    11341129      CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name 
    11351130      CHARACTER(len=50)              ::   clname                   ! file name 
    11361131      CHARACTER(len=1)               ::   cl1                      ! 1 character 
    11371132      CHARACTER(len=2)               ::   cl2                      ! 1 character 
    1138       CHARACTER(len=255)             ::   tfo 
    11391133      INTEGER                        ::   idt                      ! time-step in seconds 
    11401134      INTEGER                        ::   iddss, ihhss             ! number of seconds in 1 day, 1 hour and 1 year 
    … …  
    11561150 
    11571151      ! frequency of the call of iom_put (attribut: freq_op) 
    1158       tfo = TRIM(i2str(idt))//'s' 
    1159       CALL iom_set_field_attr('field_definition', freq_op=tfo) 
    1160       CALL iom_set_field_attr('SBC'   , freq_op=TRIM(i2str(idt* nn_fsbc ))//'s') 
    1161       CALL iom_set_field_attr('ptrc_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s') 
    1162       CALL iom_set_field_attr('diad_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s') 
    1163         
     1152      CALL event__set_attribut( 'field_definition', attr( field__freq_op, idt           ) )    ! model time-step 
     1153      CALL event__set_attribut( 'SBC'             , attr( field__freq_op, idt * nn_fsbc ) )    ! SBC time-step 
     1154       
    11641155      ! output file names (attribut: name) 
     1156#if defined key_adam 
     1157      clsuff(:) = (/ 'grid_A', 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /)       
     1158#else 
    11651159      clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /)       
     1160#endif 
     1161      WRITE(*,*) 'set adam2' 
    11661162      DO jg = 1, SIZE(clsuff)                                                                  ! grid type 
    1167          DO jh = 1, 24                                                                         ! 1-24 hours 
    1168             WRITE(cl2,'(i2)') jh  
    1169             CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. ) 
    1170             CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), name=TRIM(clname)) 
     1163         DO jh = 1, 12                                                                         ! 1, 2, 3, 4, 6, 12 hours 
     1164            IF( MOD(12,jh) == 0 ) THEN  
     1165               WRITE(cl2,'(i2)') jh  
     1166               CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. ) 
     1167               CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1168            ENDIF 
    11711169         END DO 
    1172          DO jd = 1, 30                                                                         ! 1-30 days 
     1170         DO jd = 1, 5, 2                                                                       ! 1, 3, 5 days 
    11731171            WRITE(cl1,'(i1)') jd  
    11741172            CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. ) 
    1175             CALL iom_set_file_attr(cl1//'d_'//clsuff(jg), name=TRIM(clname)) 
     1173            CALL event__set_attribut( cl1//'d_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
    11761174         END DO 
    1177          DO jm = 1, 11                                                                         ! 1-11 months 
    1178             WRITE(cl1,'(i1)') jm  
    1179             CALL dia_nam( clname, -jm, clsuff(jg) ) 
    1180             CALL iom_set_file_attr(cl1//'m_'//clsuff(jg), name=TRIM(clname)) 
     1175         DO jm = 1, 6                                                                          ! 1, 2, 3, 4, 6 months 
     1176            IF( MOD(6,jm) == 0 ) THEN  
     1177               WRITE(cl1,'(i1)') jm  
     1178               CALL dia_nam( clname, -jm, clsuff(jg) ) 
     1179               CALL event__set_attribut( cl1//'m_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1180            ENDIF 
    11811181         END DO 
    1182          DO jy = 1, 50                                                                         ! 1-50 years   
    1183             WRITE(cl2,'(i2)') jy  
    1184             CALL dia_nam( clname, -jy * iyymo, clsuff(jg) ) 
    1185             CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), name=TRIM(clname)) 
     1182         DO jy = 1, 10                                                                         ! 1, 2, 5, 10 years   
     1183            IF( MOD(10,jy) == 0 ) THEN  
     1184               WRITE(cl2,'(i2)') jy  
     1185               CALL dia_nam( clname, -jy * iyymo, clsuff(jg) ) 
     1186               CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 
     1187            ENDIF 
    11861188         END DO 
    11871189      END DO 
    … …  
    11931195         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    11941196         CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
    1195          CALL iom_set_domain_attr('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 
    1196          CALL iom_set_file_attr('Eq'//cl1, name_suffix= '_Eq') 
     1197         CALL event__set_attribut( 'Eq'//cl1, attr( zoom__jbegin     , iy     ) ) 
     1198         CALL event__set_attribut( 'Eq'//cl1, attr( zoom__ni         , jpiglo ) ) 
     1199         CALL event__set_attribut( 'Eq'//cl1, attr( file__name_suffix, '_Eq'  ) ) 
    11971200      END DO 
    11981201      ! TAO moorings (attributs: ibegin, jbegin, name_suffix) 
    … …  
    12091212      CALL set_mooring( zlonpira, zlatpira ) 
    12101213       
     1214      WRITE(*,*) 'set adam3' 
    12111215   END SUBROUTINE set_xmlatt 
    12121216 
    … …  
    12691273               ENDIF 
    12701274               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 
    1271                CALL iom_set_domain_attr(TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 
    1272                CALL iom_set_file_attr(TRIM(clname)//cl1, name_suffix= '_'//TRIM(clname)) 
     1275               CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__ibegin     , ix                ) ) 
     1276               CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__jbegin     , iy                ) ) 
     1277               CALL event__set_attribut( TRIM(clname)//cl1, attr( file__name_suffix, '_'//TRIM(clname) ) )       
    12731278            END DO 
    12741279         END DO 
    … …  
    12861291#endif 
    12871292 
    1288    FUNCTION i2str(int) 
    1289    IMPLICIT NONE 
    1290       INTEGER, INTENT(IN) :: int 
    1291       CHARACTER(LEN=255) :: i2str 
    1292  
    1293       WRITE(i2str,*) int 
    1294        
    1295    END FUNCTION i2str   
    1296     
     1293 
    12971294   !!====================================================================== 
    12981295END MODULE iom 
Note: See TracChangeset for help on using the changeset viewer.