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 5923 for branches – NEMO

Changeset 5923 for branches


Ignore:
Timestamp:
2015-11-25T18:46:28+01:00 (8 years ago)
Author:
cetlod
Message:

NEMO-XIOS2 : 1st implementation of the 2 versions of XIOS ; work done A. Caubel, see ticket 1635

Location:
branches/2015/dev_r5918_nemo_v3_6_STABLE_XIOS2/NEMOGCM
Files:
8 added
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5918_nemo_v3_6_STABLE_XIOS2/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5426 r5923  
    9494      CHARACTER(len=*), INTENT(in)  :: cdname 
    9595#if defined key_iomput 
     96#if defined XIOS1 
    9697      TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0) 
    9798      CHARACTER(len=19) :: cldate  
     99#else 
     100      TYPE(xios_duration)   :: dtime    = xios_duration(0, 0, 0, 0, 0, 0) 
     101      TYPE(xios_date) :: start_date 
     102#endif 
    98103      CHARACTER(len=10) :: clname 
    99104      INTEGER           ::   ji 
     
    101106      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 
    102107      !!---------------------------------------------------------------------- 
    103  
     108#if defined XIOS1 
    104109      ALLOCATE( z_bnds(jpk,2) ) 
     110#else 
     111      ALLOCATE( z_bnds(2,jpk) ) 
     112#endif 
    105113 
    106114      clname = cdname 
     
    110118 
    111119      ! calendar parameters 
     120#if defined XIOS1 
    112121      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    113122      CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") 
     
    117126      WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday  
    118127      CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 
    119  
     128#else 
     129      ! Calendar type is now defined in xml file  
     130      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     131      CASE ( 1)   ; CALL xios_define_calendar(TYPE="Gregorian", time_origin=xios_date(1900,01,01,00,00,00),start_date = xios_date(nyear,nmonth,nday,0,0,0)) 
     132      CASE ( 0)   ; CALL xios_define_calendar(TYPE="NoLeap", time_origin=xios_date(1900,01,01,00,00,00),start_date = xios_date(nyear,nmonth,nday,0,0,0)) 
     133      CASE (30)   ; CALL xios_define_calendar(TYPE="D360", time_origin=xios_date(1900,01,01,00,00,00),start_date = xios_date(nyear,nmonth,nday,0,0,0)) 
     134      END SELECT 
     135#endif 
    120136      ! horizontal grid definition 
     137 
     138#if defined XIOS1 
    121139      CALL set_scalar 
     140#endif 
    122141 
    123142      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
     
    170189 
    171190      ! Add vertical grid bounds 
     191#if defined XIOS1 
    172192      z_bnds(:      ,1) = gdepw_1d(:) 
    173193      z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
    174194      z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
     195#else 
     196      z_bnds(1      ,:) = gdepw_1d(:) 
     197      z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
     198      z_bnds(2,jpk:) = gdepw_1d(jpk) + e3t_1d(jpk) 
     199#endif 
     200 
    175201      CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
    176202      CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
    177203      CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
     204#if defined XIOS1 
    178205      z_bnds(:    ,2) = gdept_1d(:) 
    179206      z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 
    180207      z_bnds(1    ,1) = gdept_1d(1) - e3w_1d(1) 
     208#else 
     209      z_bnds(2,:) = gdept_1d(:) 
     210      z_bnds(1,2:jpk) = gdept_1d(1:jpkm1) 
     211      z_bnds(1,1) = gdept_1d(1) - e3w_1d(1) 
     212#endif 
    181213      CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
    182214 
     
    11581190      LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask 
    11591191 
     1192#if defined XIOS1 
    11601193      IF ( xios_is_valid_domain     (cdid) ) THEN 
    11611194         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     
    11641197            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  & 
    11651198            &    bounds_lat=bounds_lat, area=area ) 
    1166       ENDIF 
    1167  
     1199     ENDIF 
    11681200      IF ( xios_is_valid_domaingroup(cdid) ) THEN 
    11691201         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     
    11731205            &    bounds_lat=bounds_lat, area=area ) 
    11741206      ENDIF 
     1207 
     1208#else 
     1209      IF ( xios_is_valid_domain     (cdid) ) THEN 
     1210         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     1211            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     1212            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,                  & 
     1213            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 
     1214     ENDIF 
     1215      IF ( xios_is_valid_domaingroup(cdid) ) THEN 
     1216         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     1217            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   & 
     1218            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,                  & 
     1219            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 
     1220      ENDIF 
     1221#endif 
    11751222      CALL xios_solve_inheritance() 
    11761223 
    11771224   END SUBROUTINE iom_set_domain_attr 
     1225 
     1226#if ! defined XIOS1 
     1227  SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 
     1228     CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
     1229     INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj 
     1230 
     1231     IF ( xios_is_valid_domain     (cdid) ) THEN 
     1232         CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    & 
     1233           &   nj=nj) 
     1234    ENDIF 
     1235  END SUBROUTINE iom_set_zoom_domain_attr 
     1236#endif 
    11781237 
    11791238 
     
    11831242      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds 
    11841243      IF ( PRESENT(paxis) ) THEN 
     1244#if defined XIOS1  
    11851245         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis ) 
    11861246         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 
     1247#else 
     1248         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis ) 
     1249         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 
     1250#endif 
    11871251      ENDIF 
    11881252      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
     
    11911255   END SUBROUTINE iom_set_axis_attr 
    11921256 
    1193  
    11941257   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 
    11951258      CHARACTER(LEN=*)          , INTENT(in) ::   cdid 
     1259#if defined XIOS1  
    11961260      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_op 
    11971261      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   freq_offset 
     1262#else 
     1263      TYPE(xios_duration)   ,OPTIONAL , INTENT(in) ::   freq_op 
     1264      TYPE(xios_duration)   ,OPTIONAL , INTENT(in) ::   freq_offset 
     1265#endif 
    11981266      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    11991267      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 
    12001268      CALL xios_solve_inheritance() 
    12011269   END SUBROUTINE iom_set_field_attr 
    1202  
    12031270 
    12041271   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 
     
    12131280   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 
    12141281      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid 
    1215       CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix, output_freq 
     1282      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix 
     1283#if defined XIOS1  
     1284      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::    output_freq 
     1285#else 
     1286      TYPE(xios_duration)   ,OPTIONAL , INTENT(out) :: output_freq 
     1287#endif   
    12161288      LOGICAL                                 ::   llexist1,llexist2,llexist3 
    12171289      !--------------------------------------------------------------------- 
    12181290      IF( PRESENT( name        ) )   name = ''          ! default values 
    12191291      IF( PRESENT( name_suffix ) )   name_suffix = '' 
     1292#if defined XIOS1  
    12201293      IF( PRESENT( output_freq ) )   output_freq = '' 
     1294#else 
     1295      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0) 
     1296#endif 
    12211297      IF ( xios_is_valid_file     (cdid) ) THEN 
    12221298         CALL xios_solve_inheritance() 
     
    12391315      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid 
    12401316      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask 
     1317#if defined XIOS1  
    12411318      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask=mask ) 
    12421319      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask ) 
     1320#else 
     1321      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask3=mask ) 
     1322      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask3=mask ) 
     1323#endif 
    12431324      CALL xios_solve_inheritance() 
    12441325   END SUBROUTINE iom_set_grid_attr 
     
    12821363      ni=nlei-nldi+1 ; nj=nlej-nldj+1 
    12831364 
    1284       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) 
     1365#if defined XIOS1 
     1366     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) 
     1367#else 
     1368     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
     1369#endif      
    12851370      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    12861371      CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
     
    14301515      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0. 
    14311516 
     1517      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     1518#if defined XIOS1 
    14321519      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 
    14331520      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     
    14351522         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    14361523      ! 
    1437       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    14381524      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 
     1525#else 
     1526! Pas teste : attention aux indices ! 
     1527      CALL iom_set_domain_attr("ptr", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
     1528      CALL iom_set_domain_attr("ptr", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     1529      CALL iom_set_domain_attr("ptr", lonvalue = zlon,   & 
     1530         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
     1531       CALL iom_set_zoom_domain_attr ('ptr', ibegin=ix, nj=jpjglo) 
     1532#endif 
     1533 
    14391534      CALL iom_update_file_name('ptr') 
    14401535      ! 
     
    14551550      zz=REAL(narea,wp) 
    14561551      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 
    1457  
     1552       
    14581553   END SUBROUTINE set_scalar 
    14591554 
     
    14791574      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings 
    14801575      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings 
     1576#if ! defined XIOS1 
     1577      TYPE(xios_duration)   ::   freq_op, freq_offset 
     1578#endif 
     1579  
    14811580      !!---------------------------------------------------------------------- 
    14821581      !  
    14831582      ! frequency of the call of iom_put (attribut: freq_op) 
     1583#if defined XIOS1 
    14841584      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 
    14851585      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op = cl1//'ts', freq_offset='0ts') 
     
    14871587      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op = cl1//'ts', freq_offset='0ts') 
    14881588      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op = cl1//'ts', freq_offset='0ts') 
     1589#else 
     1590      freq_op%timestep=1         ; freq_offset%timestep=0 ; CALL iom_set_field_attr('field_definition', freq_op = freq_op, freq_offset=freq_offset) 
     1591      freq_op%timestep=nn_fsbc   ; freq_offset%timestep=0 ; CALL iom_set_field_attr('SBC', freq_op = freq_op, freq_offset=freq_offset) 
     1592      freq_op%timestep=nn_fsbc   ; freq_offset%timestep=0 ; CALL iom_set_field_attr('SBC_scalar', freq_op = freq_op, freq_offset=freq_offset) 
     1593      freq_op%timestep=nn_dttrc  ; freq_offset%timestep=0 ; CALL iom_set_field_attr('ptrc_T', freq_op = freq_op, freq_offset=freq_offset) 
     1594      freq_op%timestep=nn_dttrc  ; freq_offset%timestep=0 ; CALL iom_set_field_attr('diad_T', freq_op = freq_op, freq_offset=freq_offset) 
     1595#endif 
    14891596        
    14901597      ! output file names (attribut: name) 
     
    15081615         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    15091616         CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
     1617#if defined XIOS1          
    15101618         CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 
     1619#else 
     1620         CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo) 
     1621#endif 
    15111622         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    15121623         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 
     
    15881699               ENDIF 
    15891700               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 
     1701#if defined XIOS1 
    15901702               CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 
     1703#else 
     1704               CALL iom_set_zoom_domain_attr  (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1) 
     1705#endif 
    15911706               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         ) 
    15921707               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) 
     
    16171732      REAL(wp)           ::   zsec 
    16181733      LOGICAL            ::   llexist 
    1619       !!---------------------------------------------------------------------- 
     1734#if ! defined XIOS1 
     1735      TYPE(xios_duration)   ::   output_freq  
     1736#endif       
     1737      !!---------------------------------------------------------------------- 
     1738 
    16201739 
    16211740      DO jn = 1,2 
    1622  
     1741#if defined XIOS1 
    16231742         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = clfreq ) 
     1743#else 
     1744         output_freq = xios_duration(0,0,0,0,0,0) 
     1745         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq ) 
     1746#endif 
    16241747         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname ) 
    16251748 
     
    16321755            END DO 
    16331756 
     1757#if defined XIOS1 
    16341758            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    16351759            DO WHILE ( idx /= 0 )  
     
    16441768               idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
    16451769            END DO 
    1646  
     1770#else 
     1771            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
     1772            DO WHILE ( idx /= 0 )  
     1773              IF ( output_freq%hour /= 0 ) THEN 
     1774                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'  
     1775                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1776              ELSE IF ( output_freq%day /= 0 ) THEN 
     1777                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d'  
     1778                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1779              ELSE IF ( output_freq%month /= 0 ) THEN    
     1780                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m'  
     1781                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1782              ELSE IF ( output_freq%year /= 0 ) THEN    
     1783                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y'  
     1784                  itrlen = LEN_TRIM(ADJUSTL(clfreq)) 
     1785              ELSE 
     1786                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   & 
     1787                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 
     1788              ENDIF 
     1789              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname)) 
     1790              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 
     1791            END DO 
     1792#endif 
    16471793            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    16481794            DO WHILE ( idx /= 0 )  
Note: See TracChangeset for help on using the changeset viewer.