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 13247 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90 – NEMO

Ignore:
Timestamp:
2020-07-03T19:15:31+02:00 (4 years ago)
Author:
francesca
Message:

dev_r12558_HPC-08_epico_Extra_Halo: merge with trunk@13227, see #2366

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90

    r13229 r13247  
    5959   PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 
    6060 
    61    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    62    PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 
    63    PRIVATE iom_p1d, iom_p2d, iom_p3d, iom_p4d 
     61   PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp 
     62   PRIVATE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp 
     63   PRIVATE iom_get_123d 
     64   PRIVATE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp 
     65   PRIVATE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp 
     66   PRIVATE iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp 
     67   PRIVATE iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 
    6468#if defined key_iomput 
    6569   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 
     
    7074 
    7175   INTERFACE iom_get 
    72       MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d 
     76      MODULE PROCEDURE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp 
     77      MODULE PROCEDURE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp 
    7378   END INTERFACE 
    7479   INTERFACE iom_getatt 
     
    7984   END INTERFACE 
    8085   INTERFACE iom_rstput 
    81       MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
     86      MODULE PROCEDURE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp 
     87      MODULE PROCEDURE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp 
    8288   END INTERFACE 
    8389   INTERFACE iom_put 
    84       MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d, iom_p4d 
     90      MODULE PROCEDURE iom_p0d_sp, iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp 
     91      MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 
    8592   END INTERFACE iom_put 
    8693   
     
    153160         ! 
    154161         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    155             CALL iom_set_domain_attr("grid_T", area = e1e2t(Nis0:Nie0, Njs0:Nje0)) 
    156             CALL iom_set_domain_attr("grid_U", area = e1e2u(Nis0:Nie0, Njs0:Nje0)) 
    157             CALL iom_set_domain_attr("grid_V", area = e1e2v(Nis0:Nie0, Njs0:Nje0)) 
    158             CALL iom_set_domain_attr("grid_W", area = e1e2t(Nis0:Nie0, Njs0:Nje0)) 
     162            CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
     163            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 
     164            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 
     165            CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
    159166            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    160167            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
     
    176183         ! 
    177184         IF( ln_cfmeta .AND. .NOT. llrst_context) THEN   ! Add additional grid metadata 
    178             CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0)) 
    179             CALL iom_set_domain_attr("grid_U", area =   e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0)) 
    180             CALL iom_set_domain_attr("grid_V", area =   e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0)) 
    181             CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0)) 
     185            CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
     186            CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
     187            CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
     188            CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
    182189            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
    183190            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 
     
    881888   !!                   INTERFACE iom_get 
    882889   !!---------------------------------------------------------------------- 
    883    SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, ldxios ) 
     890   SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime, ldxios ) 
    884891      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
    885892      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable 
    886       REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field 
     893      REAL(sp)        , INTENT(  out)                 ::   pvar      ! read field 
     894      REAL(dp)                                        ::   ztmp_pvar ! tmp var to read field 
     895      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number 
     896      LOGICAL         , INTENT(in   ),     OPTIONAL   ::   ldxios    ! use xios to read restart 
     897      ! 
     898      INTEGER                                         ::   idvar     ! variable id 
     899      INTEGER                                         ::   idmspc    ! number of spatial dimensions 
     900      INTEGER         , DIMENSION(1)                  ::   itime     ! record number 
     901      CHARACTER(LEN=100)                              ::   clinfo    ! info character 
     902      CHARACTER(LEN=100)                              ::   clname    ! file name 
     903      CHARACTER(LEN=1)                                ::   cldmspc   ! 
     904      LOGICAL                                         ::   llxios 
     905      ! 
     906      llxios = .FALSE. 
     907      IF( PRESENT(ldxios) ) llxios = ldxios 
     908 
     909      IF(.NOT.llxios) THEN  ! read data using default library 
     910         itime = 1 
     911         IF( PRESENT(ktime) ) itime = ktime 
     912         ! 
     913         clname = iom_file(kiomid)%name 
     914         clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 
     915         ! 
     916         IF( kiomid > 0 ) THEN 
     917            idvar = iom_varid( kiomid, cdvar ) 
     918            IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 
     919               idmspc = iom_file ( kiomid )%ndims( idvar ) 
     920               IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1 
     921               WRITE(cldmspc , fmt='(i1)') idmspc 
     922               IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 
     923                                    &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 
     924                                    &                         'Use ncwa -a to suppress the unnecessary dimensions' ) 
     925               CALL iom_nf90_get( kiomid, idvar, ztmp_pvar, itime ) 
     926               pvar = ztmp_pvar 
     927            ENDIF 
     928         ENDIF 
     929      ELSE 
     930#if defined key_iomput 
     931         IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 
     932         CALL iom_swap( TRIM(crxios_context) ) 
     933         CALL xios_recv_field( trim(cdvar), pvar) 
     934         CALL iom_swap( TRIM(cxios_context) ) 
     935#else 
     936         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 
     937         CALL ctl_stop( 'iom_g0d', ctmp1 ) 
     938#endif 
     939      ENDIF 
     940   END SUBROUTINE iom_g0d_sp 
     941 
     942   SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime, ldxios ) 
     943      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     944      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable 
     945      REAL(dp)        , INTENT(  out)                 ::   pvar      ! read field 
    887946      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number 
    888947      LOGICAL         , INTENT(in   ),     OPTIONAL   ::   ldxios    ! use xios to read restart 
     
    929988#endif 
    930989      ENDIF 
    931    END SUBROUTINE iom_g0d 
    932  
    933    SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime,                kstart, kcount, ldxios ) 
     990   END SUBROUTINE iom_g0d_dp 
     991 
     992   SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 
    934993      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    935994      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
    936995      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
    937       REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     996      REAL(sp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     997      REAL(dp)        , ALLOCATABLE  , DIMENSION(:)           ::   ztmp_pvar ! tmp var to read field 
    938998      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    939999      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
     
    9421002      ! 
    9431003      IF( kiomid > 0 ) THEN 
    944          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom         , cdvar            , pv_r1d=pvar,   & 
    945             &                                                       ktime=ktime  ,                                   & 
    946             &                                                       kstart=kstart, kcount=kcount    , ldxios=ldxios ) 
    947       ENDIF 
    948    END SUBROUTINE iom_g1d 
    949  
    950    SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 
     1004         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1005            ALLOCATE(ztmp_pvar(size(pvar,1))) 
     1006            CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=ztmp_pvar,   & 
     1007              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     1008              &                                                     ldxios=ldxios ) 
     1009            pvar = ztmp_pvar 
     1010            DEALLOCATE(ztmp_pvar) 
     1011         END IF 
     1012      ENDIF 
     1013   END SUBROUTINE iom_g1d_sp 
     1014 
     1015 
     1016   SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 
    9511017      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    9521018      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
    9531019      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
    954       REAL(wp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field 
     1020      REAL(dp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     1021      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1022      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
     1023      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis 
     1024      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
     1025      ! 
     1026      IF( kiomid > 0 ) THEN 
     1027         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   & 
     1028              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     1029              &                                                     ldxios=ldxios ) 
     1030      ENDIF 
     1031   END SUBROUTINE iom_g1d_dp 
     1032 
     1033   SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 
     1034      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1035      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1036      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1037      REAL(sp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field 
     1038      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:)         ::   ztmp_pvar ! tmp var to read field 
    9551039      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    9561040      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    957       REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     1041      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
    9581042      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    9591043      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
     
    9621046      ! 
    9631047      IF( kiomid > 0 ) THEN 
     1048         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1049            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2))) 
     1050            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = ztmp_pvar  , ktime = ktime,   & 
     1051             &                                                      cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1052             &                                                      kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
     1053            pvar = ztmp_pvar 
     1054            DEALLOCATE(ztmp_pvar) 
     1055         ENDIF 
     1056      ENDIF 
     1057   END SUBROUTINE iom_g2d_sp 
     1058 
     1059   SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 
     1060      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1061      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1062      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1063      REAL(dp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field 
     1064      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1065      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1066      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     1067      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1068      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
     1069      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis 
     1070      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
     1071      ! 
     1072      IF( kiomid > 0 ) THEN 
    9641073         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = pvar  , ktime = ktime,   & 
    9651074            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
    9661075            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
    9671076      ENDIF 
    968    END SUBROUTINE iom_g2d 
    969  
    970    SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 
     1077   END SUBROUTINE iom_g2d_dp 
     1078 
     1079   SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 
    9711080      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    9721081      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
    9731082      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
    974       REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field 
     1083      REAL(sp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field 
     1084      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:,:)       ::   ztmp_pvar ! tmp var to read field 
    9751085      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    9761086      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    977       REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1087      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
    9781088      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    9791089      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
     
    9821092      ! 
    9831093      IF( kiomid > 0 ) THEN 
    984          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = pvar  , ktime = ktime,   & 
     1094         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1095            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 
     1096            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = ztmp_pvar  , ktime = ktime,   & 
    9851097            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
    9861098            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
    987       ENDIF 
    988    END SUBROUTINE iom_g3d 
     1099            pvar = ztmp_pvar 
     1100            DEALLOCATE(ztmp_pvar) 
     1101         END IF 
     1102      ENDIF 
     1103   END SUBROUTINE iom_g3d_sp 
     1104 
     1105   SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 
     1106      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1107      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1108      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1109      REAL(dp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field 
     1110      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1111      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1112      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1113      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1114      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
     1115      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis 
     1116      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
     1117      ! 
     1118      IF( kiomid > 0 ) THEN 
     1119         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1120            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = pvar  , ktime = ktime,   & 
     1121            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1122            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
     1123         END IF 
     1124      ENDIF 
     1125   END SUBROUTINE iom_g3d_dp 
     1126 
    9891127   !!---------------------------------------------------------------------- 
    9901128 
     
    10011139      INTEGER                    , INTENT(in   )           ::   kdom      ! Type of domain to be read 
    10021140      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar     ! Name of the variable 
    1003       REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
    1004       REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
    1005       REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
     1141      REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
     1142      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
     1143      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
    10061144      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime     ! record number 
    10071145      CHARACTER(len=1)           , INTENT(in   ), OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
    1008       REAL(wp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1146      REAL(dp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
    10091147      INTEGER                    , INTENT(in   ), OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
    10101148      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis  
     
    10291167      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable 
    10301168      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable 
    1031       REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
     1169      REAL(dp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
    10321170      REAL(wp)                       ::   zsgn        ! local value of psgn 
    10331171      INTEGER                        ::   itmp        ! temporary integer 
     
    10381176      LOGICAL                        ::   ll_only3rd  ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
    10391177      INTEGER                        ::   inlev       ! number of levels for 3D data 
    1040       REAL(wp)                       ::   gma, gmi 
     1178      REAL(dp)                       ::   gma, gmi 
    10411179      !--------------------------------------------------------------------- 
    10421180      ! 
     
    12381376!some final adjustments 
    12391377      ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 
    1240       IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1. ) 
    1241       IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1. ) 
     1378      IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp ) 
     1379      IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp ) 
    12421380 
    12431381      !--- Apply scale_factor and offset 
     
    14261564   !!                   INTERFACE iom_rstput 
    14271565   !!---------------------------------------------------------------------- 
    1428    SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1566   SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    14291567      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    14301568      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    14311569      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    14321570      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1433       REAL(wp)        , INTENT(in)                         ::   pvar     ! written field 
     1571      REAL(sp)        , INTENT(in)                         ::   pvar     ! written field 
    14341572      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    14351573      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     
    14501588            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    14511589               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1452                CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     1590               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = real(pvar, dp) ) 
    14531591            ENDIF 
    14541592         ENDIF 
    14551593      ENDIF 
    1456    END SUBROUTINE iom_rp0d 
    1457  
    1458    SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1594   END SUBROUTINE iom_rp0d_sp 
     1595 
     1596   SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    14591597      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    14601598      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    14611599      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    14621600      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1463       REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
     1601      REAL(dp)        , INTENT(in)                         ::   pvar     ! written field 
     1602      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1603      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     1604      LOGICAL :: llx                ! local xios write flag 
     1605      INTEGER :: ivid   ! variable id 
     1606 
     1607      llx = .FALSE. 
     1608      IF(PRESENT(ldxios)) llx = ldxios 
     1609      IF( llx ) THEN 
     1610#ifdef key_iomput 
     1611      IF( kt == kwrite ) THEN 
     1612          IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 
     1613          CALL xios_send_field(trim(cdvar), pvar) 
     1614      ENDIF 
     1615#endif 
     1616      ELSE 
     1617         IF( kiomid > 0 ) THEN 
     1618            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1619               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1620               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     1621            ENDIF 
     1622         ENDIF 
     1623      ENDIF 
     1624   END SUBROUTINE iom_rp0d_dp 
     1625 
     1626 
     1627   SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1628      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1629      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1630      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1631      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1632      REAL(sp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
    14641633      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    14651634      LOGICAL, OPTIONAL                                    ::   ldxios   ! xios write flag 
     
    14801649            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    14811650               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1482                CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     1651               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = real(pvar, dp) ) 
    14831652            ENDIF 
    14841653         ENDIF 
    14851654      ENDIF 
    1486    END SUBROUTINE iom_rp1d 
    1487  
    1488    SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1655   END SUBROUTINE iom_rp1d_sp 
     1656 
     1657   SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    14891658      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    14901659      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    14911660      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    14921661      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1493       REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
     1662      REAL(dp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
     1663      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1664      LOGICAL, OPTIONAL                                    ::   ldxios   ! xios write flag 
     1665      LOGICAL :: llx                ! local xios write flag 
     1666      INTEGER :: ivid   ! variable id 
     1667 
     1668      llx = .FALSE. 
     1669      IF(PRESENT(ldxios)) llx = ldxios 
     1670      IF( llx ) THEN 
     1671#ifdef key_iomput 
     1672      IF( kt == kwrite ) THEN 
     1673         IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 
     1674         CALL xios_send_field(trim(cdvar), pvar) 
     1675      ENDIF 
     1676#endif 
     1677      ELSE 
     1678         IF( kiomid > 0 ) THEN 
     1679            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1680               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1681               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     1682            ENDIF 
     1683         ENDIF 
     1684      ENDIF 
     1685   END SUBROUTINE iom_rp1d_dp 
     1686 
     1687 
     1688   SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1689      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1690      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1691      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1692      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1693      REAL(sp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
    14941694      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    14951695      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     
    15101710            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    15111711               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1512                CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     1712               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = real(pvar, dp) ) 
    15131713            ENDIF 
    15141714         ENDIF 
    15151715      ENDIF 
    1516    END SUBROUTINE iom_rp2d 
    1517  
    1518    SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1716   END SUBROUTINE iom_rp2d_sp 
     1717 
     1718   SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    15191719      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    15201720      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    15211721      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    15221722      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1523       REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
     1723      REAL(dp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
     1724      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1725      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     1726      LOGICAL :: llx 
     1727      INTEGER :: ivid   ! variable id 
     1728 
     1729      llx = .FALSE. 
     1730      IF(PRESENT(ldxios)) llx = ldxios 
     1731      IF( llx ) THEN 
     1732#ifdef key_iomput 
     1733      IF( kt == kwrite ) THEN 
     1734         IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 
     1735         CALL xios_send_field(trim(cdvar), pvar) 
     1736      ENDIF 
     1737#endif 
     1738      ELSE 
     1739         IF( kiomid > 0 ) THEN 
     1740            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1741               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1742               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     1743            ENDIF 
     1744         ENDIF 
     1745      ENDIF 
     1746   END SUBROUTINE iom_rp2d_dp 
     1747 
     1748 
     1749   SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1750      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1751      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1752      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1753      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1754      REAL(sp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
    15241755      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    15251756      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     
    15401771            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    15411772               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1773               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = real(pvar, dp) ) 
     1774            ENDIF 
     1775         ENDIF 
     1776      ENDIF 
     1777   END SUBROUTINE iom_rp3d_sp 
     1778 
     1779   SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1780      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1781      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1782      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1783      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1784      REAL(dp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
     1785      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1786      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     1787      LOGICAL :: llx                 ! local xios write flag 
     1788      INTEGER :: ivid   ! variable id 
     1789 
     1790      llx = .FALSE. 
     1791      IF(PRESENT(ldxios)) llx = ldxios 
     1792      IF( llx ) THEN 
     1793#ifdef key_iomput 
     1794      IF( kt == kwrite ) THEN 
     1795         IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 
     1796         CALL xios_send_field(trim(cdvar), pvar) 
     1797      ENDIF 
     1798#endif 
     1799      ELSE 
     1800         IF( kiomid > 0 ) THEN 
     1801            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1802               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    15421803               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
    15431804            ENDIF 
    15441805         ENDIF 
    15451806      ENDIF 
    1546    END SUBROUTINE iom_rp3d 
     1807   END SUBROUTINE iom_rp3d_dp 
     1808 
    15471809 
    15481810 
     
    15961858   !!                   INTERFACE iom_put 
    15971859   !!---------------------------------------------------------------------- 
    1598    SUBROUTINE iom_p0d( cdname, pfield0d ) 
     1860   SUBROUTINE iom_p0d_sp( cdname, pfield0d ) 
    15991861      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    1600       REAL(wp)        , INTENT(in) ::   pfield0d 
     1862      REAL(sp)        , INTENT(in) ::   pfield0d 
    16011863!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
    16021864#if defined key_iomput 
     
    16071869      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    16081870#endif 
    1609    END SUBROUTINE iom_p0d 
    1610  
    1611    SUBROUTINE iom_p1d( cdname, pfield1d ) 
     1871   END SUBROUTINE iom_p0d_sp 
     1872 
     1873   SUBROUTINE iom_p0d_dp( cdname, pfield0d ) 
     1874      CHARACTER(LEN=*), INTENT(in) ::   cdname 
     1875      REAL(dp)        , INTENT(in) ::   pfield0d 
     1876!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
     1877#if defined key_iomput 
     1878!!clem      zz(:,:)=pfield0d 
     1879!!clem      CALL xios_send_field(cdname, zz) 
     1880      CALL xios_send_field(cdname, (/pfield0d/))  
     1881#else 
     1882      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
     1883#endif 
     1884   END SUBROUTINE iom_p0d_dp 
     1885 
     1886 
     1887   SUBROUTINE iom_p1d_sp( cdname, pfield1d ) 
    16121888      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
    1613       REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d 
     1889      REAL(sp),     DIMENSION(:), INTENT(in) ::   pfield1d 
    16141890#if defined key_iomput 
    16151891      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
     
    16171893      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
    16181894#endif 
    1619    END SUBROUTINE iom_p1d 
    1620  
    1621    SUBROUTINE iom_p2d( cdname, pfield2d ) 
     1895   END SUBROUTINE iom_p1d_sp 
     1896 
     1897   SUBROUTINE iom_p1d_dp( cdname, pfield1d ) 
     1898      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
     1899      REAL(dp),     DIMENSION(:), INTENT(in) ::   pfield1d 
     1900#if defined key_iomput 
     1901      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
     1902#else 
     1903      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
     1904#endif 
     1905   END SUBROUTINE iom_p1d_dp 
     1906 
     1907   SUBROUTINE iom_p2d_sp( cdname, pfield2d ) 
    16221908      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    1623       REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
     1909      REAL(sp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    16241910      IF( iom_use(cdname) ) THEN 
    16251911#if defined key_iomput 
     
    16331919#endif 
    16341920      ENDIF 
    1635    END SUBROUTINE iom_p2d 
    1636  
    1637    SUBROUTINE iom_p3d( cdname, pfield3d ) 
     1921   END SUBROUTINE iom_p2d_sp 
     1922 
     1923   SUBROUTINE iom_p2d_dp( cdname, pfield2d ) 
     1924      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
     1925      REAL(dp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
     1926      IF( iom_use(cdname) ) THEN 
     1927#if defined key_iomput 
     1928         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 
     1929            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d 
     1930         ELSE 
     1931            CALL xios_send_field( cdname, pfield2d ) 
     1932         ENDIF 
     1933#else 
     1934         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1935#endif 
     1936      ENDIF 
     1937   END SUBROUTINE iom_p2d_dp 
     1938 
     1939   SUBROUTINE iom_p3d_sp( cdname, pfield3d ) 
    16381940      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    1639       REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
     1941      REAL(sp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    16401942      IF( iom_use(cdname) ) THEN 
    16411943#if defined key_iomput 
     
    16491951#endif 
    16501952      ENDIF 
    1651    END SUBROUTINE iom_p3d 
    1652  
    1653    SUBROUTINE iom_p4d( cdname, pfield4d ) 
     1953   END SUBROUTINE iom_p3d_sp 
     1954 
     1955   SUBROUTINE iom_p3d_dp( cdname, pfield3d ) 
    16541956      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    1655       REAL(wp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
     1957      REAL(dp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
     1958      IF( iom_use(cdname) ) THEN 
     1959#if defined key_iomput 
     1960         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 
     1961            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d 
     1962         ELSE 
     1963            CALL xios_send_field( cdname, pfield3d ) 
     1964         ENDIF 
     1965#else 
     1966         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1967#endif 
     1968      ENDIF 
     1969   END SUBROUTINE iom_p3d_dp 
     1970 
     1971   SUBROUTINE iom_p4d_sp( cdname, pfield4d ) 
     1972      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     1973      REAL(sp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
    16561974      IF( iom_use(cdname) ) THEN 
    16571975#if defined key_iomput 
     
    16651983#endif 
    16661984      ENDIF 
    1667    END SUBROUTINE iom_p4d 
    1668  
     1985   END SUBROUTINE iom_p4d_sp 
     1986 
     1987   SUBROUTINE iom_p4d_dp( cdname, pfield4d ) 
     1988      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     1989      REAL(dp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
     1990      IF( iom_use(cdname) ) THEN 
     1991#if defined key_iomput 
     1992         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 
     1993            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d 
     1994         ELSE 
     1995            CALL xios_send_field (cdname, pfield4d ) 
     1996         ENDIF 
     1997#else 
     1998         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1999#endif 
     2000      ENDIF 
     2001   END SUBROUTINE iom_p4d_dp 
    16692002 
    16702003#if defined key_iomput 
     
    16822015      INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    16832016      INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex 
    1684       REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    1685       REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
     2017      REAL(dp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
     2018      REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
    16862019      LOGICAL , DIMENSION(:)  , OPTIONAL, INTENT(in) ::   mask 
    16872020      !!---------------------------------------------------------------------- 
     
    17462079      !!---------------------------------------------------------------------- 
    17472080      IF( PRESENT(paxis) ) THEN 
    1748          IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis ) 
    1749          IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 
    1750       ENDIF 
    1751       IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
    1752       IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 
     2081         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 
     2082         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 
     2083      ENDIF 
     2084      IF( PRESENT(bounds) ) THEN 
     2085         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=real(bounds, dp) ) 
     2086         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=real(bounds, dp) ) 
     2087      ELSE 
     2088         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid) 
     2089         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid) 
     2090      END IF 
    17532091      CALL xios_solve_inheritance() 
    17542092   END SUBROUTINE iom_set_axis_attr 
     
    18652203!don't define lon and lat for restart reading context.  
    18662204      IF ( .NOT.ldrxios ) & 
    1867          CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),   & 
    1868          &                                        latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)))   
     2205         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp),   & 
     2206         &                                        latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp ))   
    18692207      ! 
    18702208      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN 
     
    18832221   END SUBROUTINE set_grid 
    18842222 
    1885  
    18862223   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 
    18872224      !!---------------------------------------------------------------------- 
     
    18972234      INTEGER :: ji, jj, jn 
    18982235      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    1899       !                                                 ! represents the bottom-left corner of cell (i,j) 
     2236      !                                                 ! represents the 
     2237      !                                                 bottom-left corner of 
     2238      !                                                 cell (i,j) 
    19002239      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
    19012240      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells 
     
    19132252      ! 
    19142253      z_fld(:,:) = 1._wp 
    1915       CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. )    ! Working array for location of northfold 
     2254      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! Working array for location of northfold 
    19162255      ! 
    19172256      ! Cell vertices that can be defined 
     
    19352274      END_2D 
    19362275      ! 
    1937       CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)),           & 
    1938           &                                    bounds_lon = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), nvertex=4 ) 
    1939       ! 
    1940       DEALLOCATE( z_bnds, z_fld, z_rot )  
     2276      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp),           & 
     2277          &                                    bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 ) 
     2278      ! 
     2279      DEALLOCATE( z_bnds, z_fld, z_rot ) 
    19412280      ! 
    19422281   END SUBROUTINE set_grid_bounds 
    1943  
    19442282 
    19452283   SUBROUTINE set_grid_znl( plat ) 
     
    19582296      ALLOCATE( zlon(Ni_0*Nj_0) )       ;       zlon(:) = 0._wp 
    19592297      ! 
    1960 !      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    1961       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     2298!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
     2299      CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    19622300      CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0) 
    19632301      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 
    1964       CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
    1965          &                             latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)))   
     2302      CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp),   & 
     2303         &                             latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))   
    19662304      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj_0) 
    19672305      ! 
     
    19782316      !! 
    19792317      !!---------------------------------------------------------------------- 
    1980       REAL(wp), DIMENSION(1)   ::   zz = 1. 
     2318      REAL(dp), DIMENSION(1)   ::   zz = 1. 
    19812319      !!---------------------------------------------------------------------- 
    19822320      ! 
     
    20402378         cl1 = clgrd(jg) 
    20412379         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    2042          CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
     2380         CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 
    20432381         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 ) 
    20442382         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
     
    22662604      ! 
    22672605      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day 
    2268          CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 
     2606         CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec ) 
    22692607         isec = 86400 
    22702608      ENDIF 
     
    23242662      CHARACTER(LEN=*), INTENT(in ) ::   cdname 
    23252663      REAL(wp)        , INTENT(out) ::   pmiss_val    
     2664      REAL(dp)                      ::   ztmp_pmiss_val    
    23262665#if defined key_iomput 
    23272666      ! get missing value 
    2328       CALL xios_get_field_attr( cdname, default_value = pmiss_val ) 
     2667      CALL xios_get_field_attr( cdname, default_value = ztmp_pmiss_val ) 
     2668      pmiss_val = ztmp_pmiss_val 
    23292669#else 
    23302670      IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings 
Note: See TracChangeset for help on using the changeset viewer.