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 13226 for NEMO/trunk/src/OCE/IOM – NEMO

Ignore:
Timestamp:
2020-07-02T16:24:31+02:00 (4 years ago)
Author:
orioltp
Message:

Merging dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation into the trunk

Location:
NEMO/trunk/src/OCE/IOM
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/IOM/iom.F90

    r13214 r13226  
    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   
     
    169176         ! 
    170177         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    171             CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej)) 
    172             CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej)) 
    173             CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej)) 
    174             CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej)) 
     178            CALL iom_set_domain_attr("grid_T", area = real( e1e2t(nldi:nlei, nldj:nlej), dp)) 
     179            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(nldi:nlei, nldj:nlej), dp)) 
     180            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(nldi:nlei, nldj:nlej), dp)) 
     181            CALL iom_set_domain_attr("grid_W", area = real( e1e2t(nldi:nlei, nldj:nlej), dp)) 
    175182            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    176183            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
     
    192199         ! 
    193200         IF( ln_cfmeta .AND. .NOT. llrst_context) THEN   ! Add additional grid metadata 
    194             CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
    195             CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 
    196             CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej)) 
    197             CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
     201            CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(nldi:nlei, nldj:nlej), dp)) 
     202            CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej), dp) ) 
     203            CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej), dp) ) 
     204            CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(nldi:nlei, nldj:nlej), dp ) ) 
    198205            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
    199206            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 
     
    941948   !!                   INTERFACE iom_get 
    942949   !!---------------------------------------------------------------------- 
    943    SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, ldxios ) 
     950   SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime, ldxios ) 
    944951      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
    945952      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable 
    946       REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field 
     953      REAL(sp)        , INTENT(  out)                 ::   pvar      ! read field 
     954      REAL(dp)                                        ::   ztmp_pvar ! tmp var to read field 
     955      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number 
     956      LOGICAL         , INTENT(in   ),     OPTIONAL   ::   ldxios    ! use xios to read restart 
     957      ! 
     958      INTEGER                                         ::   idvar     ! variable id 
     959      INTEGER                                         ::   idmspc    ! number of spatial dimensions 
     960      INTEGER         , DIMENSION(1)                  ::   itime     ! record number 
     961      CHARACTER(LEN=100)                              ::   clinfo    ! info character 
     962      CHARACTER(LEN=100)                              ::   clname    ! file name 
     963      CHARACTER(LEN=1)                                ::   cldmspc   ! 
     964      LOGICAL                                         ::   llxios 
     965      ! 
     966      llxios = .FALSE. 
     967      IF( PRESENT(ldxios) ) llxios = ldxios 
     968 
     969      IF(.NOT.llxios) THEN  ! read data using default library 
     970         itime = 1 
     971         IF( PRESENT(ktime) ) itime = ktime 
     972         ! 
     973         clname = iom_file(kiomid)%name 
     974         clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 
     975         ! 
     976         IF( kiomid > 0 ) THEN 
     977            idvar = iom_varid( kiomid, cdvar ) 
     978            IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 
     979               idmspc = iom_file ( kiomid )%ndims( idvar ) 
     980               IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1 
     981               WRITE(cldmspc , fmt='(i1)') idmspc 
     982               IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 
     983                                    &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 
     984                                    &                         'Use ncwa -a to suppress the unnecessary dimensions' ) 
     985               CALL iom_nf90_get( kiomid, idvar, ztmp_pvar, itime ) 
     986               pvar = ztmp_pvar 
     987            ENDIF 
     988         ENDIF 
     989      ELSE 
     990#if defined key_iomput 
     991         IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 
     992         CALL iom_swap( TRIM(crxios_context) ) 
     993         CALL xios_recv_field( trim(cdvar), pvar) 
     994         CALL iom_swap( TRIM(cxios_context) ) 
     995#else 
     996         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 
     997         CALL ctl_stop( 'iom_g0d', ctmp1 ) 
     998#endif 
     999      ENDIF 
     1000   END SUBROUTINE iom_g0d_sp 
     1001 
     1002   SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime, ldxios ) 
     1003      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     1004      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable 
     1005      REAL(dp)        , INTENT(  out)                 ::   pvar      ! read field 
    9471006      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number 
    9481007      LOGICAL         , INTENT(in   ),     OPTIONAL   ::   ldxios    ! use xios to read restart 
     
    9891048#endif 
    9901049      ENDIF 
    991    END SUBROUTINE iom_g0d 
    992  
    993    SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 
     1050   END SUBROUTINE iom_g0d_dp 
     1051 
     1052   SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 
    9941053      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    9951054      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
    9961055      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
    997       REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     1056      REAL(sp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     1057      REAL(dp)        , ALLOCATABLE  , DIMENSION(:)           ::   ztmp_pvar ! tmp var to read field 
    9981058      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    9991059      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
     
    10021062      ! 
    10031063      IF( kiomid > 0 ) THEN 
     1064         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1065            ALLOCATE(ztmp_pvar(size(pvar,1))) 
     1066            CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=ztmp_pvar,   & 
     1067              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     1068              &                                                     ldxios=ldxios ) 
     1069            pvar = ztmp_pvar 
     1070            DEALLOCATE(ztmp_pvar) 
     1071         END IF 
     1072      ENDIF 
     1073   END SUBROUTINE iom_g1d_sp 
     1074 
     1075 
     1076   SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 
     1077      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1078      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1079      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1080      REAL(dp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     1081      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1082      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
     1083      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis 
     1084      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
     1085      ! 
     1086      IF( kiomid > 0 ) THEN 
    10041087         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   & 
    10051088              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    10061089              &                                                     ldxios=ldxios ) 
    10071090      ENDIF 
    1008    END SUBROUTINE iom_g1d 
    1009  
    1010    SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 
     1091   END SUBROUTINE iom_g1d_dp 
     1092 
     1093   SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 
    10111094      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    10121095      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
    10131096      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable 
    1014       REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
     1097      REAL(sp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
     1098      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:)           ::   ztmp_pvar ! tmp var to read field 
    10151099      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number 
    10161100      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
     
    10231107      ! 
    10241108      IF( kiomid > 0 ) THEN 
     1109         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1110            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2))) 
     1111            CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=ztmp_pvar,   & 
     1112              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     1113              &                                                     lrowattr=lrowattr,  ldxios=ldxios) 
     1114            pvar = ztmp_pvar 
     1115            DEALLOCATE(ztmp_pvar) 
     1116         END IF 
     1117      ENDIF 
     1118   END SUBROUTINE iom_g2d_sp 
     1119 
     1120 
     1121   SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 
     1122      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
     1123      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
     1124      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable 
     1125      REAL(dp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
     1126      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number 
     1127      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
     1128      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
     1129      LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
     1130                                                                               ! look for and use a file attribute 
     1131                                                                               ! called open_ocean_jstart to set the start 
     1132                                                                               ! value for the 2nd dimension (netcdf only) 
     1133      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios      ! read data using XIOS 
     1134      ! 
     1135      IF( kiomid > 0 ) THEN 
    10251136         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    10261137              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    10271138              &                                                     lrowattr=lrowattr,  ldxios=ldxios) 
    10281139      ENDIF 
    1029    END SUBROUTINE iom_g2d 
    1030  
    1031    SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 
     1140   END SUBROUTINE iom_g2d_dp 
     1141 
     1142   SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 
    10321143      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    10331144      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
    10341145      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable 
    1035       REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
     1146      REAL(sp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
     1147      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:,:)           ::   ztmp_pvar ! tmp var to read field 
    10361148      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number 
    10371149      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
     
    10441156      ! 
    10451157      IF( kiomid > 0 ) THEN 
     1158         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1159            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 
     1160            CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=ztmp_pvar,   & 
     1161              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     1162              &                                                     lrowattr=lrowattr, ldxios=ldxios ) 
     1163            pvar = ztmp_pvar 
     1164            DEALLOCATE(ztmp_pvar) 
     1165         END IF 
     1166      ENDIF 
     1167   END SUBROUTINE iom_g3d_sp 
     1168 
     1169   SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 
     1170      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
     1171      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
     1172      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable 
     1173      REAL(dp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
     1174      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number 
     1175      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
     1176      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
     1177      LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
     1178                                                                                 ! look for and use a file attribute 
     1179                                                                                 ! called open_ocean_jstart to set the start 
     1180                                                                                 ! value for the 2nd dimension (netcdf only) 
     1181      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios        ! read data using XIOS 
     1182      ! 
     1183      IF( kiomid > 0 ) THEN 
    10461184         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    10471185              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    10481186              &                                                     lrowattr=lrowattr, ldxios=ldxios ) 
    10491187      ENDIF 
    1050    END SUBROUTINE iom_g3d 
     1188   END SUBROUTINE iom_g3d_dp 
     1189 
     1190 
     1191 
    10511192   !!---------------------------------------------------------------------- 
    10521193 
     
    10651206      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read 
    10661207      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable 
    1067       REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
    1068       REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
    1069       REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case) 
     1208      REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
     1209      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
     1210      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case) 
    10701211      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number 
    10711212      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis  
     
    10961237      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable 
    10971238      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable 
    1098       REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
     1239      REAL(dp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
    10991240      INTEGER                        ::   itmp        ! temporary integer 
    11001241      CHARACTER(LEN=256)             ::   clinfo      ! info character 
     
    11031244      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
    11041245      INTEGER                        ::   inlev       ! number of levels for 3D data 
    1105       REAL(wp)                       ::   gma, gmi 
     1246      REAL(dp)                       ::   gma, gmi 
    11061247      !--------------------------------------------------------------------- 
    11071248      ! 
     
    13121453               !--- overlap areas and extra hallows (mpp) 
    13131454               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1314                   CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing ) 
     1455                  CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    13151456               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    13161457                  ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    13171458                  IF( icnt(3) == inlev ) THEN 
    1318                      CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 
     1459                     CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    13191460                  ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    13201461                     DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
     
    13411482            CALL xios_recv_field( trim(cdvar), pv_r3d) 
    13421483            IF(idom /= jpdom_unknown ) then 
    1343                 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
     1484                CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing) 
    13441485            ENDIF 
    13451486         ELSEIF( PRESENT(pv_r2d) ) THEN 
     
    13481489            CALL xios_recv_field( trim(cdvar), pv_r2d) 
    13491490            IF(idom /= jpdom_unknown ) THEN 
    1350                 CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
     1491                CALL lbc_lnk('iom', pv_r2d,'Z',-999.0_wp, kfillmode = jpfillnothing) 
    13511492            ENDIF 
    13521493         ELSEIF( PRESENT(pv_r1d) ) THEN 
     
    13631504!some final adjustments 
    13641505      ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 
    1365       IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1. ) 
    1366       IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1. ) 
     1506      IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp ) 
     1507      IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp ) 
    13671508 
    13681509      !--- Apply scale_factor and offset 
     
    15511692   !!                   INTERFACE iom_rstput 
    15521693   !!---------------------------------------------------------------------- 
    1553    SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1694   SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    15541695      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    15551696      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    15561697      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    15571698      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1558       REAL(wp)        , INTENT(in)                         ::   pvar     ! written field 
     1699      REAL(sp)        , INTENT(in)                         ::   pvar     ! written field 
    15591700      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    15601701      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     
    15751716            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    15761717               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1577                CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     1718               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = real(pvar, dp) ) 
    15781719            ENDIF 
    15791720         ENDIF 
    15801721      ENDIF 
    1581    END SUBROUTINE iom_rp0d 
    1582  
    1583    SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1722   END SUBROUTINE iom_rp0d_sp 
     1723 
     1724   SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    15841725      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    15851726      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    15861727      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    15871728      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1588       REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
     1729      REAL(dp)        , INTENT(in)                         ::   pvar     ! written field 
     1730      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1731      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     1732      LOGICAL :: llx                ! local xios write flag 
     1733      INTEGER :: ivid   ! variable id 
     1734 
     1735      llx = .FALSE. 
     1736      IF(PRESENT(ldxios)) llx = ldxios 
     1737      IF( llx ) THEN 
     1738#ifdef key_iomput 
     1739      IF( kt == kwrite ) THEN 
     1740          IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 
     1741          CALL xios_send_field(trim(cdvar), pvar) 
     1742      ENDIF 
     1743#endif 
     1744      ELSE 
     1745         IF( kiomid > 0 ) THEN 
     1746            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1747               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1748               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     1749            ENDIF 
     1750         ENDIF 
     1751      ENDIF 
     1752   END SUBROUTINE iom_rp0d_dp 
     1753 
     1754 
     1755   SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1756      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1757      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1758      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1759      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1760      REAL(sp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
    15891761      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    15901762      LOGICAL, OPTIONAL                                    ::   ldxios   ! xios write flag 
     
    16051777            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    16061778               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1607                CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     1779               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = real(pvar, dp) ) 
    16081780            ENDIF 
    16091781         ENDIF 
    16101782      ENDIF 
    1611    END SUBROUTINE iom_rp1d 
    1612  
    1613    SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1783   END SUBROUTINE iom_rp1d_sp 
     1784 
     1785   SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    16141786      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    16151787      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    16161788      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    16171789      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1618       REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
     1790      REAL(dp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
     1791      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1792      LOGICAL, OPTIONAL                                    ::   ldxios   ! xios write flag 
     1793      LOGICAL :: llx                ! local xios write flag 
     1794      INTEGER :: ivid   ! variable id 
     1795 
     1796      llx = .FALSE. 
     1797      IF(PRESENT(ldxios)) llx = ldxios 
     1798      IF( llx ) THEN 
     1799#ifdef key_iomput 
     1800      IF( kt == kwrite ) THEN 
     1801         IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 
     1802         CALL xios_send_field(trim(cdvar), pvar) 
     1803      ENDIF 
     1804#endif 
     1805      ELSE 
     1806         IF( kiomid > 0 ) THEN 
     1807            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1808               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1809               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     1810            ENDIF 
     1811         ENDIF 
     1812      ENDIF 
     1813   END SUBROUTINE iom_rp1d_dp 
     1814 
     1815 
     1816   SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1817      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1818      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1819      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1820      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1821      REAL(sp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
    16191822      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    16201823      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     
    16351838            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    16361839               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1637                CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     1840               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = real(pvar, dp) ) 
    16381841            ENDIF 
    16391842         ENDIF 
    16401843      ENDIF 
    1641    END SUBROUTINE iom_rp2d 
    1642  
    1643    SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1844   END SUBROUTINE iom_rp2d_sp 
     1845 
     1846   SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    16441847      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    16451848      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    16461849      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    16471850      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1648       REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
     1851      REAL(dp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
     1852      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1853      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     1854      LOGICAL :: llx 
     1855      INTEGER :: ivid   ! variable id 
     1856 
     1857      llx = .FALSE. 
     1858      IF(PRESENT(ldxios)) llx = ldxios 
     1859      IF( llx ) THEN 
     1860#ifdef key_iomput 
     1861      IF( kt == kwrite ) THEN 
     1862         IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 
     1863         CALL xios_send_field(trim(cdvar), pvar) 
     1864      ENDIF 
     1865#endif 
     1866      ELSE 
     1867         IF( kiomid > 0 ) THEN 
     1868            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1869               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1870               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     1871            ENDIF 
     1872         ENDIF 
     1873      ENDIF 
     1874   END SUBROUTINE iom_rp2d_dp 
     1875 
     1876 
     1877   SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1878      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1879      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1880      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1881      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1882      REAL(sp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
    16491883      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    16501884      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     
    16651899            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    16661900               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1901               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = real(pvar, dp) ) 
     1902            ENDIF 
     1903         ENDIF 
     1904      ENDIF 
     1905   END SUBROUTINE iom_rp3d_sp 
     1906 
     1907   SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1908      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1909      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1910      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1911      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1912      REAL(dp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
     1913      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1914      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     1915      LOGICAL :: llx                 ! local xios write flag 
     1916      INTEGER :: ivid   ! variable id 
     1917 
     1918      llx = .FALSE. 
     1919      IF(PRESENT(ldxios)) llx = ldxios 
     1920      IF( llx ) THEN 
     1921#ifdef key_iomput 
     1922      IF( kt == kwrite ) THEN 
     1923         IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 
     1924         CALL xios_send_field(trim(cdvar), pvar) 
     1925      ENDIF 
     1926#endif 
     1927      ELSE 
     1928         IF( kiomid > 0 ) THEN 
     1929            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1930               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    16671931               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
    16681932            ENDIF 
    16691933         ENDIF 
    16701934      ENDIF 
    1671    END SUBROUTINE iom_rp3d 
     1935   END SUBROUTINE iom_rp3d_dp 
     1936 
    16721937 
    16731938 
     
    17211986   !!                   INTERFACE iom_put 
    17221987   !!---------------------------------------------------------------------- 
    1723    SUBROUTINE iom_p0d( cdname, pfield0d ) 
     1988   SUBROUTINE iom_p0d_sp( cdname, pfield0d ) 
    17241989      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    1725       REAL(wp)        , INTENT(in) ::   pfield0d 
     1990      REAL(sp)        , INTENT(in) ::   pfield0d 
    17261991!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
    17271992#if defined key_iomput 
     
    17321997      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    17331998#endif 
    1734    END SUBROUTINE iom_p0d 
    1735  
    1736    SUBROUTINE iom_p1d( cdname, pfield1d ) 
     1999   END SUBROUTINE iom_p0d_sp 
     2000 
     2001   SUBROUTINE iom_p0d_dp( cdname, pfield0d ) 
     2002      CHARACTER(LEN=*), INTENT(in) ::   cdname 
     2003      REAL(dp)        , INTENT(in) ::   pfield0d 
     2004!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
     2005#if defined key_iomput 
     2006!!clem      zz(:,:)=pfield0d 
     2007!!clem      CALL xios_send_field(cdname, zz) 
     2008      CALL xios_send_field(cdname, (/pfield0d/))  
     2009#else 
     2010      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
     2011#endif 
     2012   END SUBROUTINE iom_p0d_dp 
     2013 
     2014 
     2015   SUBROUTINE iom_p1d_sp( cdname, pfield1d ) 
    17372016      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
    1738       REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d 
     2017      REAL(sp),     DIMENSION(:), INTENT(in) ::   pfield1d 
    17392018#if defined key_iomput 
    17402019      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
     
    17422021      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
    17432022#endif 
    1744    END SUBROUTINE iom_p1d 
    1745  
    1746    SUBROUTINE iom_p2d( cdname, pfield2d ) 
     2023   END SUBROUTINE iom_p1d_sp 
     2024 
     2025   SUBROUTINE iom_p1d_dp( cdname, pfield1d ) 
     2026      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
     2027      REAL(dp),     DIMENSION(:), INTENT(in) ::   pfield1d 
     2028#if defined key_iomput 
     2029      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
     2030#else 
     2031      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
     2032#endif 
     2033   END SUBROUTINE iom_p1d_dp 
     2034 
     2035   SUBROUTINE iom_p2d_sp( cdname, pfield2d ) 
    17472036      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    1748       REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
     2037      REAL(sp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    17492038#if defined key_iomput 
    17502039      CALL xios_send_field(cdname, pfield2d) 
     
    17522041      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    17532042#endif 
    1754    END SUBROUTINE iom_p2d 
    1755  
    1756    SUBROUTINE iom_p3d( cdname, pfield3d ) 
     2043   END SUBROUTINE iom_p2d_sp 
     2044 
     2045   SUBROUTINE iom_p2d_dp( cdname, pfield2d ) 
     2046      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
     2047      REAL(dp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
     2048#if defined key_iomput 
     2049      CALL xios_send_field(cdname, pfield2d) 
     2050#else 
     2051      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
     2052#endif 
     2053   END SUBROUTINE iom_p2d_dp 
     2054 
     2055   SUBROUTINE iom_p3d_sp( cdname, pfield3d ) 
    17572056      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    1758       REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
     2057      REAL(sp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    17592058#if defined key_iomput 
    17602059      CALL xios_send_field( cdname, pfield3d ) 
     
    17622061      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    17632062#endif 
    1764    END SUBROUTINE iom_p3d 
    1765  
    1766    SUBROUTINE iom_p4d( cdname, pfield4d ) 
     2063   END SUBROUTINE iom_p3d_sp 
     2064 
     2065   SUBROUTINE iom_p3d_dp( cdname, pfield3d ) 
    17672066      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    1768       REAL(wp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
     2067      REAL(dp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
     2068#if defined key_iomput 
     2069      CALL xios_send_field( cdname, pfield3d ) 
     2070#else 
     2071      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
     2072#endif 
     2073   END SUBROUTINE iom_p3d_dp 
     2074 
     2075   SUBROUTINE iom_p4d_sp( cdname, pfield4d ) 
     2076      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     2077      REAL(sp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
    17692078#if defined key_iomput 
    17702079      CALL xios_send_field(cdname, pfield4d) 
     
    17722081      IF( .FALSE. )   WRITE(numout,*) cdname, pfield4d   ! useless test to avoid compilation warnings 
    17732082#endif 
    1774    END SUBROUTINE iom_p4d 
    1775  
     2083   END SUBROUTINE iom_p4d_sp 
     2084 
     2085   SUBROUTINE iom_p4d_dp( cdname, pfield4d ) 
     2086      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     2087      REAL(dp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
     2088#if defined key_iomput 
     2089      CALL xios_send_field(cdname, pfield4d) 
     2090#else 
     2091      IF( .FALSE. )   WRITE(numout,*) cdname, pfield4d   ! useless test to avoid compilation warnings 
     2092#endif 
     2093   END SUBROUTINE iom_p4d_dp 
    17762094 
    17772095#if defined key_iomput 
     
    17892107      INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    17902108      INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex 
    1791       REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    1792       REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
     2109      REAL(dp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
     2110      REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
    17932111      LOGICAL , DIMENSION(:)  , OPTIONAL, INTENT(in) ::   mask 
    17942112      !!---------------------------------------------------------------------- 
     
    18532171      !!---------------------------------------------------------------------- 
    18542172      IF( PRESENT(paxis) ) THEN 
    1855          IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis ) 
    1856          IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 
    1857       ENDIF 
    1858       IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
    1859       IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 
     2173         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 
     2174         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 
     2175      ENDIF 
     2176      IF( PRESENT(bounds) ) THEN 
     2177         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=real(bounds, dp) ) 
     2178         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=real(bounds, dp) ) 
     2179      ELSE 
     2180         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid) 
     2181         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid) 
     2182      END IF 
    18602183      CALL xios_solve_inheritance() 
    18612184   END SUBROUTINE iom_set_axis_attr 
     
    19762299!don't define lon and lat for restart reading context.  
    19772300      IF ( .NOT.ldrxios ) & 
    1978          CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    1979          &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)) 
     2301         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), dp),   & 
     2302         &                                     latvalue = real(RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)),dp )  
    19802303      ! 
    19812304      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN 
     
    19832306         SELECT CASE ( cdgrd ) 
    19842307         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:) 
    1985          CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1. ) 
    1986          CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1. ) 
     2308         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1.0_wp ) 
     2309         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1.0_wp ) 
    19872310         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1) 
    19882311         END SELECT 
     
    20272350      ! 
    20282351      z_fld(:,:) = 1._wp 
    2029       CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. )    ! Working array for location of northfold 
     2352      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! Working array for location of northfold 
    20302353      ! 
    20312354      ! Cell vertices that can be defined 
     
    20452368      ! Cell vertices on boundries 
    20462369      DO jn = 1, 4 
    2047          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pfillval=999._wp ) 
    2048          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pfillval=999._wp ) 
     2370         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1.0_wp, pfillval=999._wp ) 
     2371         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1.0_wp, pfillval=999._wp ) 
    20492372      END DO 
    20502373      ! 
     
    20922415      ENDIF 
    20932416      ! 
    2094       CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           & 
    2095           &                                    bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 
     2417      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), dp),           & 
     2418          &                                    bounds_lon =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), dp), nvertex=4 ) 
    20962419      ! 
    20972420      DEALLOCATE( z_bnds, z_fld, z_rot )  
     
    21172440      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp 
    21182441      ! 
    2119 !      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    2120       CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     2442!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
     2443      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) 
    21212444      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    21222445      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    2123       CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
    2124          &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
     2446      CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp),   & 
     2447         &                             latvalue = real(RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)),dp))   
    21252448      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
    21262449      ! 
     
    21372460      !! 
    21382461      !!---------------------------------------------------------------------- 
    2139       REAL(wp), DIMENSION(1)   ::   zz = 1. 
     2462      REAL(dp), DIMENSION(1)   ::   zz = 1. 
    21402463      !!---------------------------------------------------------------------- 
    21412464      ! 
     
    21992522         cl1 = clgrd(jg) 
    22002523         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    2201          CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
     2524         CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 
    22022525         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 ) 
    22032526         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
     
    24252748      ! 
    24262749      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day 
    2427          CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 
     2750         CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec ) 
    24282751         isec = 86400 
    24292752      ENDIF 
     
    24832806      CHARACTER(LEN=*), INTENT(in ) ::   cdname 
    24842807      REAL(wp)        , INTENT(out) ::   pmiss_val    
     2808      REAL(dp)                      ::   ztmp_pmiss_val    
    24852809#if defined key_iomput 
    24862810      ! get missing value 
    2487       CALL xios_get_field_attr( cdname, default_value = pmiss_val ) 
     2811      CALL xios_get_field_attr( cdname, default_value = ztmp_pmiss_val ) 
     2812      pmiss_val = ztmp_pmiss_val 
    24882813#else 
    24892814      IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings 
  • NEMO/trunk/src/OCE/IOM/iom_nf90.F90

    r13009 r13226  
    3333 
    3434   INTERFACE iom_nf90_get 
    35       MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d 
     35      MODULE PROCEDURE iom_nf90_g0d_sp                    
     36      MODULE PROCEDURE iom_nf90_g0d_dp, iom_nf90_g123d_dp 
    3637   END INTERFACE 
    3738   INTERFACE iom_nf90_rstput 
    38       MODULE PROCEDURE iom_nf90_rp0123d 
     39      MODULE PROCEDURE iom_nf90_rp0123d_dp 
    3940   END INTERFACE 
    4041 
     
    276277   !!---------------------------------------------------------------------- 
    277278 
    278    SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart ) 
     279   SUBROUTINE iom_nf90_g0d_sp( kiomid, kvid, pvar, kstart ) 
    279280      !!----------------------------------------------------------------------- 
    280281      !!                  ***  ROUTINE  iom_nf90_g0d  *** 
     
    284285      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file 
    285286      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id 
    286       REAL(wp),               INTENT(  out)            ::   pvar     ! read field 
     287      REAL(sp),               INTENT(  out)            ::   pvar     ! read field 
    287288      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis 
    288289      ! 
     
    291292      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    292293      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 
    293    END SUBROUTINE iom_nf90_g0d 
    294  
    295  
    296    SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   & 
     294   END SUBROUTINE iom_nf90_g0d_sp 
     295 
     296   SUBROUTINE iom_nf90_g0d_dp( kiomid, kvid, pvar, kstart ) 
     297      !!----------------------------------------------------------------------- 
     298      !!                  ***  ROUTINE  iom_nf90_g0d  *** 
     299      !! 
     300      !! ** Purpose : read a scalar with NF90 
     301      !!----------------------------------------------------------------------- 
     302      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file 
     303      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id 
     304      REAL(dp),               INTENT(  out)            ::   pvar     ! read field 
     305      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis 
     306      ! 
     307      CHARACTER(LEN=100)      ::   clinfo   ! info character 
     308      !--------------------------------------------------------------------- 
     309      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
     310      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 
     311   END SUBROUTINE iom_nf90_g0d_dp 
     312 
     313   SUBROUTINE iom_nf90_g123d_dp( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   & 
    297314         &                    pv_r1d, pv_r2d, pv_r3d ) 
    298315      !!----------------------------------------------------------------------- 
     
    309326      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis 
    310327      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes 
    311       REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
    312       REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
    313       REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
     328      REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
     329      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
     330      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
    314331      ! 
    315332      CHARACTER(LEN=100) ::   clinfo               ! info character 
     
    332349      ENDIF 
    333350      ! 
    334    END SUBROUTINE iom_nf90_g123d 
     351   END SUBROUTINE iom_nf90_g123d_dp 
     352 
    335353 
    336354 
     
    506524   END SUBROUTINE iom_nf90_putatt 
    507525 
    508  
    509    SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
     526   SUBROUTINE iom_nf90_rp0123d_dp( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
    510527         &                                  pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 
    511528      !!-------------------------------------------------------------------- 
     
    520537      INTEGER                     , INTENT(in)           ::   kvid     ! variable id 
    521538      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8) 
    522       REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field 
    523       REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
    524       REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
    525       REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
     539      REAL(dp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field 
     540      REAL(dp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
     541      REAL(dp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
     542      REAL(dp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
    526543      ! 
    527544      INTEGER               :: idims                ! number of dimension 
     
    704721      ENDIF 
    705722      !      
    706    END SUBROUTINE iom_nf90_rp0123d 
     723   END SUBROUTINE iom_nf90_rp0123d_dp 
    707724 
    708725 
Note: See TracChangeset for help on using the changeset viewer.