Newer
Older
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
REAL(dp) , INTENT( out) :: pvar ! read field
INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
!
INTEGER :: idvar ! variable id
INTEGER :: idmspc ! number of spatial dimensions
INTEGER , DIMENSION(1) :: itime ! record number
CHARACTER(LEN=100) :: clinfo ! info character
CHARACTER(LEN=100) :: clname ! file name
CHARACTER(LEN=1) :: cldmspc !
CHARACTER(LEN=lc) :: context
!
CALL set_xios_context(kiomid, context)
IF(context == "NONE") THEN ! read data using default library
itime = 1
IF( PRESENT(ktime) ) itime = ktime
!
clname = iom_file(kiomid)%name
Guillaume Samson
committed
clinfo = ' iom_g0d, file: '//TRIM(clname)//', var: '//TRIM(cdvar)
!
IF( kiomid > 0 ) THEN
idvar = iom_varid( kiomid, cdvar )
IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
idmspc = iom_file ( kiomid )%ndims( idvar )
IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1
WRITE(cldmspc , fmt='(i1)') idmspc
IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
& 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
& 'Use ncwa -a to suppress the unnecessary dimensions' )
CALL iom_nf90_get( kiomid, idvar, pvar, itime )
ENDIF
ENDIF
ELSE
#if defined key_xios
Guillaume Samson
committed
IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', TRIM(cdvar)
Guillaume Samson
committed
CALL xios_recv_field( TRIM(cdvar), pvar)
Guillaume Samson
committed
WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//TRIM(clname)//', var:'//TRIM(cdvar)
CALL ctl_stop( 'iom_g0d', ctmp1 )
#endif
ENDIF
END SUBROUTINE iom_g0d_dp
SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
REAL(sp) , INTENT( out), DIMENSION(:) :: pvar ! read field
INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading
INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvsp1d = pvar, &
& ktime = ktime, kstart = kstart, kcount = kcount )
ENDIF
END SUBROUTINE iom_g1d_sp
SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
REAL(dp) , INTENT( out), DIMENSION(:) :: pvar ! read field
INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading
INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvdp1d = pvar, &
& ktime = ktime, kstart = kstart, kcount = kcount)
ENDIF
END SUBROUTINE iom_g1d_dp
SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount)
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
REAL(sp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field
INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
REAL(sp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold
INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading
INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvsp2d = pvar, &
& cd_type = cd_type, psgn_sp = psgn, kfill = kfill, &
& ktime = ktime, kstart = kstart, kcount = kcount )
ENDIF
END SUBROUTINE iom_g2d_sp
SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount)
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
REAL(dp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field
INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold
INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading
INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvdp2d = pvar, &
& cd_type = cd_type, psgn_dp = psgn, kfill = kfill, &
& ktime = ktime, kstart = kstart, kcount = kcount )
ENDIF
END SUBROUTINE iom_g2d_dp
SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
REAL(sp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field
INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
REAL(sp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold
INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading
INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvsp3d = pvar, &
& cd_type = cd_type, psgn_sp = psgn, kfill = kfill, &
& ktime = ktime, kstart = kstart, kcount = kcount )
ENDIF
END SUBROUTINE iom_g3d_sp
SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
REAL(dp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field
INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold
INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading
INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvdp3d = pvar, &
& cd_type = cd_type, psgn_dp = psgn, kfill = kfill, &
& ktime = ktime, kstart = kstart, kcount = kcount )
ENDIF
END SUBROUTINE iom_g3d_dp
!!----------------------------------------------------------------------
SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pvsp1d, pvsp2d, pvsp3d, pvdp1d, pvdp2d, pvdp3d, &
& ktime , cd_type, psgn_sp, psgn_dp, kfill, kstart, kcount )
!!-----------------------------------------------------------------------
!! *** ROUTINE iom_get_123d ***
!!
!! ** Purpose : read a 1D/2D/3D variable
!!
!! ** Method : read ONE record at each CALL
!!-----------------------------------------------------------------------
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable
REAL(sp), DIMENSION(:) , INTENT( out), OPTIONAL :: pvsp1d ! read field (1D case), single precision
REAL(sp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pvsp2d ! read field (2D case), single precision
REAL(sp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pvsp3d ! read field (3D case), single precision
REAL(dp), DIMENSION(:) , INTENT( out), OPTIONAL :: pvdp1d ! read field (1D case), double precision
REAL(dp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pvdp2d ! read field (2D case), double precision
REAL(dp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pvdp3d ! read field (3D case), double precision
INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
CHARACTER(len=1) , INTENT(in ), OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
REAL(sp) , INTENT(in ), OPTIONAL :: psgn_sp ! -1.(1.) : (not) change sign across the north fold
REAL(dp) , INTENT(in ), OPTIONAL :: psgn_dp ! -1.(1.) : (not) change sign across the north fold
INTEGER , INTENT(in ), OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis
INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis
!
LOGICAL :: llok ! true if ok!
INTEGER :: jl ! loop on number of dimension
INTEGER :: idom ! type of domain
INTEGER :: idvar ! id of the variable
INTEGER :: inbdim ! number of dimensions of the variable
INTEGER :: idmspc ! number of spatial dimensions
INTEGER :: itime ! record number
INTEGER :: istop ! temporary value of nstop
INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes
INTEGER :: ji, jj ! loop counters
INTEGER :: irankpv !
INTEGER :: ind1, ind2 ! substring index
INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis
INTEGER, DIMENSION(jpmax_dims) :: icnt ! number of value to read along each axis
INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable
INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable
REAL(sp) :: zscf_sp, zofs_sp ! sacle_factor and add_offset, single precision
REAL(dp) :: zscf_dp, zofs_dp ! sacle_factor and add_offset, double precision
REAL(sp) :: zsgn_sp ! local value of psgn, single precision
REAL(dp) :: zsgn_dp ! local value of psgn, double precision
INTEGER :: itmp ! temporary integer
CHARACTER(LEN=256) :: clinfo ! info character
CHARACTER(LEN=256) :: clname ! file name
CHARACTER(LEN=1) :: clrankpv, cldmspc !
CHARACTER(LEN=1) :: cl_type ! local value of cd_type
LOGICAL :: ll_only3rd ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension.
LOGICAL :: llis1d, llis2d, llis3d
LOGICAL :: llsp ! use single precision
INTEGER :: inlev ! number of levels for 3D data
!---------------------------------------------------------------------
CHARACTER(LEN=lc) :: context
!
CALL set_xios_context(kiomid, context)
!
llsp = PRESENT(pvsp1d) .OR. PRESENT(pvsp2d) .OR. PRESENT(pvsp3d)
IF( llsp ) THEN
llis1d = PRESENT(pvsp1d) ; IF( llis1d ) ishape(1:1) = SHAPE(pvsp1d)
llis2d = PRESENT(pvsp2d) ; IF( llis2d ) ishape(1:2) = SHAPE(pvsp2d)
llis3d = PRESENT(pvsp3d) ; IF( llis3d ) ishape(1:3) = SHAPE(pvsp3d)
ELSE
llis1d = PRESENT(pvdp1d) ; IF( llis1d ) ishape(1:1) = SHAPE(pvdp1d)
llis2d = PRESENT(pvdp2d) ; IF( llis2d ) ishape(1:2) = SHAPE(pvdp2d)
llis3d = PRESENT(pvdp3d) ; IF( llis3d ) ishape(1:3) = SHAPE(pvdp3d)
ENDIF
IF( llis3d ) inlev = ishape(3)
!
idom = kdom
istop = nstop
!
IF(context == "NONE") THEN
clname = iom_file(kiomid)%name ! esier to read
Guillaume Samson
committed
clinfo = ' iom_get_123d, file: '//TRIM(clname)//', var: '//TRIM(cdvar)
Guillaume Samson
committed
IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(TRIM(clinfo), 'kcount present needs kstart present')
IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(TRIM(clinfo), 'kstart present needs kcount present')
IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_auto_xy ) &
& CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy')
IF( idom == jpdom_auto_xy .AND. .NOT. PRESENT(kstart) ) &
& CALL ctl_stop(TRIM(clinfo), 'idom = jpdom_auto_xy requires kstart to be present')
!
! Search for the variable in the data base (eventually actualize data)
!
idvar = iom_varid( kiomid, cdvar )
IF( idvar > 0 ) THEN
!
idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) ! to write iom_file(kiomid)%dimsz in a shorter way
inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file
idmspc = inbdim ! number of spatial dimensions in the file
IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1
Guillaume Samson
committed
IF( idmspc > 3 ) CALL ctl_stop(TRIM(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')
!
! Identify the domain in case of jpdom_auto definition
IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN
idom = jpdom_global ! default
! else: if the file name finishes with _xxxx.nc with xxxx any number
ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF
ENDIF
!
! check the consistency between input array and data rank in the file
!
! initializations
itime = 1
IF( PRESENT(ktime) ) itime = ktime
!
irankpv = 1 * COUNT( (/ llis1d /) ) + 2 * COUNT( (/ llis2d /) ) + 3 * COUNT( (/ llis3d /) )
WRITE(clrankpv, fmt='(i1)') irankpv
WRITE(cldmspc , fmt='(i1)') idmspc
!
IF( idmspc < irankpv ) THEN ! it seems we want to read more than we can...
IF( llis3d .AND. idmspc == 2 ) THEN ! 3D input array from 2D spatial data in the file:
llok = inlev == 1 ! -> 3rd dimension must be equal to 1
ELSEIF( llis3d .AND. idmspc == 1 ) THEN ! 3D input array from 1D spatial data in the file:
llok = inlev == 1 .AND. ishape(2) == 1 ! -> 2nd and 3rd dimensions must be equal to 1
ELSEIF( llis3d .AND. idmspc == 2 ) THEN ! 2D input array from 1D spatial data in the file:
llok = ishape(2) == 1 ! -> 2nd dimension must be equal to 1
ELSE
llok = .FALSE.
ENDIF
IF( .NOT. llok ) CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', &
& '=> cannot read a true '//clrankpv//'D array from this file...' )
ELSEIF( idmspc == irankpv ) THEN
IF( llis1d .AND. idom /= jpdom_unknown ) &
& CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
ELSEIF( idmspc > irankpv ) THEN ! it seems we want to read less than we should...
IF( llis2d .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
Guillaume Samson
committed
CALL ctl_warn( TRIM(clinfo), '2D array input but 3 spatial dimensions in the file...' , &
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
& 'As the size of the z dimension is 1 and as we try to read the first record, ', &
& 'we accept this case, even if there is a possible mix-up between z and time dimension' )
idmspc = idmspc - 1
!!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation
!ELSE
! CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,', &
! & 'we do not accept data with '//cldmspc//' spatial dimensions' , &
! & 'Use ncwa -a to suppress the unnecessary dimensions' )
ENDIF
ENDIF
!
! definition of istart and icnt
!
icnt (:) = 1 ! default definition (simple way to deal with special cases listed above)
istart(:) = 1 ! default definition (simple way to deal with special cases listed above)
istart(idmspc+1) = itime ! temporal dimenstion
!
IF( idom == jpdom_unknown ) THEN
IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN
istart(1:idmspc) = kstart(1:idmspc)
icnt (1:idmspc) = kcount(1:idmspc)
ELSE
icnt (1:idmspc) = idimsz(1:idmspc)
ENDIF
ELSE ! not a 1D array as pv(sd)p1d requires jpdom_unknown
! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0
IF( idom == jpdom_global ) istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /)
icnt(1:2) = (/ Ni_0, Nj_0 /)
IF( idom == jpdom_auto_xy ) THEN
istart(3) = kstart(3)
icnt (3) = kcount(3)
ELSE
icnt (3) = inlev
ENDIF
ENDIF
ENDIF
!
! check that istart and icnt can be used with this file
!-
DO jl = 1, jpmax_dims
itmp = istart(jl)+icnt(jl)-1
IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl)
Guillaume Samson
committed
CALL ctl_stop( TRIM(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )
ENDIF
END DO
!
! check that icnt matches the input array
!-
IF( idom == jpdom_unknown ) THEN
ctmp1 = 'd'
ELSE ! we must redefine ishape as we don't read the full array
IF( llis2d ) THEN
IF( llsp ) THEN ; ishape(1:2) = SHAPE(pvsp2d(Nis0:Nie0,Njs0:Nje0 ))
ELSE ; ishape(1:2) = SHAPE(pvdp2d(Nis0:Nie0,Njs0:Nje0 ))
ENDIF
ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)'
IF( llis3d ) THEN
IF( llsp ) THEN ; ishape(1:3) = SHAPE(pvsp3d(Nis0:Nie0,Njs0:Nje0,:))
ELSE ; ishape(1:3) = SHAPE(pvdp3d(Nis0:Nie0,Njs0:Nje0,:))
ENDIF
ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)'
ENDIF
ENDIF
DO jl = 1, irankpv
WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
IF( llsp ) THEN
IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pvsp'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
ELSE
IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pvdp'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
ENDIF
END DO
ENDIF
! read the data
!-
IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...
!
! find the right index of the array to be read
IF( idom /= jpdom_unknown ) THEN ; ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0
ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
ENDIF
CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &
& pvsp1d, pvsp2d, pvsp3d, pvdp1d, pvdp2d, pvdp3d )
IF( istop == nstop ) THEN ! no additional errors until this point...
IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
cl_type = 'T'
IF( PRESENT(cd_type) ) cl_type = cd_type
IF( llsp ) THEN
zsgn_sp = 1._sp
IF( PRESENT(psgn_sp) ) zsgn_sp = psgn_sp
IF( llis2d .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
CALL lbc_lnk( 'iom', pvsp2d, cl_type, zsgn_sp, kfillmode = kfill )
ELSEIF( llis3d .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
CALL lbc_lnk( 'iom', pvsp3d, cl_type, zsgn_sp, kfillmode = kfill )
ENDIF
ELSE
zsgn_dp = 1._dp
IF( PRESENT(psgn_dp) ) zsgn_dp = psgn_dp
IF( llis2d .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
CALL lbc_lnk( 'iom', pvdp2d, cl_type, zsgn_dp, kfillmode = kfill )
ELSEIF( llis3d .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
CALL lbc_lnk( 'iom', pvdp3d, cl_type, zsgn_dp, kfillmode = kfill )
ENDIF
!--- overlap areas and extra hallows (mpp)
!
ELSE
! return if istop == nstop is false
RETURN
ENDIF
ELSE
! return if statment idvar > 0 .AND. istop == nstop is false
RETURN
ENDIF
!
ELSE ! read using XIOS. Only if key_xios is defined
#if defined key_xios
!would be good to be able to check which context is active and swap only if current is not restart
idvar = iom_varid( kiomid, cdvar )
CALL iom_swap(context)
IF( llsp ) THEN
zsgn_sp = 1._sp ; IF( PRESENT(psgn_sp) ) zsgn_sp = psgn_sp
ELSE
zsgn_dp = 1._dp ; IF( PRESENT(psgn_dp) ) zsgn_dp = psgn_dp
ENDIF
cl_type = 'T'
IF( PRESENT(cd_type) ) cl_type = cd_type
IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar)
IF( llsp ) THEN ; CALL xios_recv_field( TRIM(cdvar), pvsp3d )
ELSE ; CALL xios_recv_field( TRIM(cdvar), pvdp3d )
ENDIF
IF( llsp ) THEN ; CALL lbc_lnk( 'iom', pvsp3d, cl_type, zsgn_sp, kfillmode = kfill)
ELSE ; CALL lbc_lnk( 'iom', pvdp3d, cl_type, zsgn_dp, kfillmode = kfill)
ENDIF
IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar)
IF( llsp ) THEN ; CALL xios_recv_field( TRIM(cdvar), pvsp2d )
ELSE ; CALL xios_recv_field( TRIM(cdvar), pvdp2d )
ENDIF
IF( llsp ) THEN ; CALL lbc_lnk('iom', pvsp2d, cl_type, zsgn_sp, kfillmode = kfill)
ELSE ; CALL lbc_lnk('iom', pvdp2d, cl_type, zsgn_dp, kfillmode = kfill)
ENDIF
IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar)
IF( llsp ) THEN ; CALL xios_recv_field( TRIM(cdvar), pvsp1d )
ELSE ; CALL xios_recv_field( TRIM(cdvar), pvdp1d )
ENDIF
ENDIF
CALL iom_swap(cxios_context)
#else
istop = istop + 1
Guillaume Samson
committed
clinfo = 'Can not use XIOS in iom_get_123d, file: '//TRIM(clname)//', var:'//TRIM(cdvar)
#endif
ENDIF
!--- Apply scale_factor and offset
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
IF( llsp ) THEN
zscf_sp = iom_file(kiomid)%scf(idvar) ! scale factor
zofs_sp = iom_file(kiomid)%ofs(idvar) ! offset
IF( llis1d ) THEN
IF( zscf_sp /= 1._sp ) pvsp1d(: ) = pvsp1d(: ) * zscf_sp
IF( zofs_sp /= 0._sp ) pvsp1d(: ) = pvsp1d(: ) + zofs_sp
ELSEIF( llis2d ) THEN
IF( zscf_sp /= 1._sp ) pvsp2d(:,: ) = pvsp2d(:,: ) * zscf_sp
IF( zofs_sp /= 0._sp ) pvsp2d(:,: ) = pvsp2d(:,: ) + zofs_sp
ELSEIF( llis3d ) THEN
IF( zscf_sp /= 1._sp ) pvsp3d(:,:,:) = pvsp3d(:,:,:) * zscf_sp
IF( zofs_sp /= 0._sp ) pvsp3d(:,:,:) = pvsp3d(:,:,:) + zofs_sp
ENDIF
ELSE
zscf_dp = iom_file(kiomid)%scf(idvar) ! scale factor
zofs_dp = iom_file(kiomid)%ofs(idvar) ! offset
IF( llis1d ) THEN
IF( zscf_dp /= 1._dp ) pvdp1d(: ) = pvdp1d(: ) * zscf_dp
IF( zofs_dp /= 0._dp ) pvdp1d(: ) = pvdp1d(: ) + zofs_dp
ELSEIF( llis2d ) THEN
IF( zscf_dp /= 1._dp ) pvdp2d(:,: ) = pvdp2d(:,: ) * zscf_dp
IF( zofs_dp /= 0._dp ) pvdp2d(:,: ) = pvdp2d(:,: ) + zofs_dp
ELSEIF( llis3d ) THEN
IF( zscf_dp /= 1._dp ) pvdp3d(:,:,:) = pvdp3d(:,:,:) * zscf_dp
IF( zofs_dp /= 0._dp ) pvdp3d(:,:,:) = pvdp3d(:,:,:) + zofs_dp
ENDIF
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
ENDIF
!
END SUBROUTINE iom_get_123d
SUBROUTINE iom_get_var( cdname, z2d)
CHARACTER(LEN=*), INTENT(in ) :: cdname
REAL(wp), DIMENSION(jpi,jpj) :: z2d
#if defined key_xios
IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN
z2d(:,:) = 0._wp
CALL xios_recv_field( cdname, z2d)
ENDIF
#else
IF( .FALSE. ) WRITE(numout,*) cdname, z2d ! useless test to avoid compilation warnings
#endif
END SUBROUTINE iom_get_var
FUNCTION iom_getszuld ( kiomid )
!!-----------------------------------------------------------------------
!! *** FUNCTION iom_getszuld ***
!!
!! ** Purpose : get the size of the unlimited dimension in a file
!! (return -1 if not found)
!!-----------------------------------------------------------------------
INTEGER, INTENT(in ) :: kiomid ! file Identifier
!
INTEGER :: iom_getszuld
!!-----------------------------------------------------------------------
iom_getszuld = -1
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%iduld > 0 ) iom_getszuld = iom_file(kiomid)%lenuld
ENDIF
END FUNCTION iom_getszuld
!!----------------------------------------------------------------------
!! INTERFACE iom_chkatt
!!----------------------------------------------------------------------
SUBROUTINE iom_chkatt( kiomid, cdatt, llok, ksize, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute
LOGICAL , INTENT( out) :: llok ! Error code
INTEGER , INTENT( out), OPTIONAL :: ksize ! Size of the attribute array
CHARACTER(len=*), INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_chkatt( kiomid, cdatt, llok, ksize=ksize, cdvar=cdvar )
ENDIF
!
END SUBROUTINE iom_chkatt
!!----------------------------------------------------------------------
!! INTERFACE iom_getatt
!!----------------------------------------------------------------------
SUBROUTINE iom_g0d_iatt( kiomid, cdatt, katt0d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
INTEGER , INTENT( out) :: katt0d ! read field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, katt0d = katt0d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_g0d_iatt
SUBROUTINE iom_g1d_iatt( kiomid, cdatt, katt1d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
INTEGER, DIMENSION(:) , INTENT( out) :: katt1d ! read field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, katt1d = katt1d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_g1d_iatt
SUBROUTINE iom_g0d_ratt( kiomid, cdatt, patt0d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
REAL(wp) , INTENT( out) :: patt0d ! read field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, patt0d = patt0d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_g0d_ratt
SUBROUTINE iom_g1d_ratt( kiomid, cdatt, patt1d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
REAL(wp), DIMENSION(:), INTENT( out) :: patt1d ! read field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, patt1d = patt1d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_g1d_ratt
SUBROUTINE iom_g0d_catt( kiomid, cdatt, cdatt0d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
CHARACTER(len=*) , INTENT( out) :: cdatt0d ! read field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_g0d_catt
!!----------------------------------------------------------------------
!! INTERFACE iom_putatt
!!----------------------------------------------------------------------
SUBROUTINE iom_p0d_iatt( kiomid, cdatt, katt0d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
INTEGER , INTENT(in ) :: katt0d ! written field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, katt0d = katt0d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_p0d_iatt
SUBROUTINE iom_p1d_iatt( kiomid, cdatt, katt1d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
INTEGER, DIMENSION(:) , INTENT(in ) :: katt1d ! written field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, katt1d = katt1d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_p1d_iatt
SUBROUTINE iom_p0d_ratt( kiomid, cdatt, patt0d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
REAL(wp) , INTENT(in ) :: patt0d ! written field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, patt0d = patt0d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_p0d_ratt
SUBROUTINE iom_p1d_ratt( kiomid, cdatt, patt1d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
REAL(wp), DIMENSION(:), INTENT(in ) :: patt1d ! written field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, patt1d = patt1d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_p1d_ratt
SUBROUTINE iom_p0d_catt( kiomid, cdatt, cdatt0d, cdvar )
INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
CHARACTER(len=*) , INTENT(in ) :: cdatt0d ! written field
CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
!
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
ENDIF
END SUBROUTINE iom_p0d_catt
!!----------------------------------------------------------------------
!! INTERFACE iom_rstput
!!----------------------------------------------------------------------
SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
INTEGER , INTENT(in) :: kt ! ocean time-step
INTEGER , INTENT(in) :: kwrite ! writing time-step
INTEGER , INTENT(in) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
REAL(sp) , INTENT(in) :: pvar ! written field
INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
!
LOGICAL :: llx ! local xios write flag
INTEGER :: ivid ! variable id
CHARACTER(LEN=lc) :: context
!
CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp0d = pvar )
!
END SUBROUTINE iom_rp0d_sp
SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
INTEGER , INTENT(in) :: kt ! ocean time-step
INTEGER , INTENT(in) :: kwrite ! writing time-step
INTEGER , INTENT(in) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
REAL(dp) , INTENT(in) :: pvar ! written field
INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
!
LOGICAL :: llx ! local xios write flag
INTEGER :: ivid ! variable id
CHARACTER(LEN=lc) :: context
!
CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvdp0d = pvar )
!
END SUBROUTINE iom_rp0d_dp
SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
INTEGER , INTENT(in) :: kt ! ocean time-step
INTEGER , INTENT(in) :: kwrite ! writing time-step
INTEGER , INTENT(in) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field
INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
!
LOGICAL :: llx ! local xios write flag
INTEGER :: ivid ! variable id
CHARACTER(LEN=lc) :: context
!
CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp1d = pvar )
!
END SUBROUTINE iom_rp1d_sp
SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
INTEGER , INTENT(in) :: kt ! ocean time-step
INTEGER , INTENT(in) :: kwrite ! writing time-step
INTEGER , INTENT(in) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field
INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
!
LOGICAL :: llx ! local xios write flag
INTEGER :: ivid ! variable id
CHARACTER(LEN=lc) :: context
!
CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvdp1d = pvar )
!
SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
INTEGER , INTENT(in) :: kt ! ocean time-step
INTEGER , INTENT(in) :: kwrite ! writing time-step
INTEGER , INTENT(in) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field
INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
!
LOGICAL :: llx
INTEGER :: ivid ! variable id
CHARACTER(LEN=lc) :: context
!
CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp2d = pvar )
!
END SUBROUTINE iom_rp2d_sp
SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
INTEGER , INTENT(in) :: kt ! ocean time-step
INTEGER , INTENT(in) :: kwrite ! writing time-step
INTEGER , INTENT(in) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field
INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
!
LOGICAL :: llx
INTEGER :: ivid ! variable id
CHARACTER(LEN=lc) :: context
!
CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvdp2d = pvar )
!
END SUBROUTINE iom_rp2d_dp
SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
INTEGER , INTENT(in) :: kt ! ocean time-step
INTEGER , INTENT(in) :: kwrite ! writing time-step
INTEGER , INTENT(in) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field
INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
!
LOGICAL :: llx ! local xios write flag
INTEGER :: ivid ! variable id
CHARACTER(LEN=lc) :: context
!
CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp3d = pvar )
!
END SUBROUTINE iom_rp3d_sp
SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
INTEGER , INTENT(in) :: kt ! ocean time-step
INTEGER , INTENT(in) :: kwrite ! writing time-step
INTEGER , INTENT(in) :: kiomid ! Identifier of the file
CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field
INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
!
LOGICAL :: llx ! local xios write flag
INTEGER :: ivid ! variable id
CHARACTER(LEN=lc) :: context
!
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvdp3d = pvar )
!
END SUBROUTINE iom_rp3d_dp
SUBROUTINE iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp0d, pvsp1d, pvsp2d, pvsp3d, pvdp0d, pvdp1d, pvdp2d, pvdp3d )
INTEGER , INTENT(in) :: kt ! ocean time-step
INTEGER , INTENT(in) :: kwrite ! writing time-step
INTEGER , INTENT(in) :: kiomid ! Identifier of the file
CHARACTER(len=*) , INTENT(in) :: cdvar ! time axis name
INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
REAL(sp) , INTENT(in), OPTIONAL :: pvsp0d ! read field (0D case), single precision
REAL(sp), DIMENSION(:) , INTENT(in), OPTIONAL :: pvsp1d ! read field (1D case), single precision
REAL(sp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: pvsp2d ! read field (2D case), single precision
REAL(sp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: pvsp3d ! read field (3D case), single precision
REAL(dp) , INTENT(in), OPTIONAL :: pvdp0d ! read field (0D case), double precision
REAL(dp), DIMENSION(:) , INTENT(in), OPTIONAL :: pvdp1d ! read field (1D case), double precision
REAL(dp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: pvdp2d ! read field (2D case), double precision
REAL(dp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: pvdp3d ! read field (3D case), double precision
!
LOGICAL :: llx ! local xios write flag
INTEGER :: ivid ! variable id
CHARACTER(LEN=lc) :: context
!
CALL set_xios_context(kiomid, context)
llx = .NOT. (context == "NONE")
IF( llx ) THEN
#ifdef key_xios
IF( kt == kwrite ) THEN
IF(lwp) write(numout,*) 'RESTART: write (XIOS) ',TRIM(cdvar)
IF( PRESENT(pvsp0d) ) CALL iom_put(TRIM(cdvar), pvsp0d)
IF( PRESENT(pvsp1d) ) CALL iom_put(TRIM(cdvar), pvsp1d)
IF( PRESENT(pvsp2d) ) CALL iom_put(TRIM(cdvar), pvsp2d)
IF( PRESENT(pvsp3d) ) CALL iom_put(TRIM(cdvar), pvsp3d)
IF( PRESENT(pvdp0d) ) CALL iom_put(TRIM(cdvar), pvdp0d)
IF( PRESENT(pvdp1d) ) CALL iom_put(TRIM(cdvar), pvdp1d)
IF( PRESENT(pvdp2d) ) CALL iom_put(TRIM(cdvar), pvdp2d)
IF( PRESENT(pvdp3d) ) CALL iom_put(TRIM(cdvar), pvdp3d)
IF(lwp) write(numout,*) 'RESTART: define (XIOS)',TRIM(cdvar)
CALL iom_set_rstw_active( TRIM(cdvar), rs0 = pvsp0d, rs1 = pvsp1d, rs2 = pvsp2d, rs3 = pvsp3d &
& , rd0 = pvdp0d, rd1 = pvdp1d, rd2 = pvdp2d, rd3 = pvdp3d )
CALL iom_swap(cxios_context)
ENDIF
#endif
ELSE
IF( kiomid > 0 ) THEN
IF( iom_file(kiomid)%nfid > 0 ) THEN
ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pvsp0d, pvsp1d, pvsp2d, pvsp3d, &
& pvdp0d, pvdp1d, pvdp2d, pvdp3d )
END SUBROUTINE iom_rp0123d
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
SUBROUTINE iom_delay_rst( cdaction, cdcpnt, kncid )
!!---------------------------------------------------------------------
!! Routine iom_delay_rst: used read/write restart related to mpp_delay
!!
!!---------------------------------------------------------------------
CHARACTER(len=*), INTENT(in ) :: cdaction !
CHARACTER(len=*), INTENT(in ) :: cdcpnt
INTEGER , INTENT(in ) :: kncid
!
INTEGER :: ji
INTEGER :: indim
LOGICAL :: llattexist
REAL(wp), ALLOCATABLE, DIMENSION(:) :: zreal1d
!!---------------------------------------------------------------------
!
! ===================================
IF( TRIM(cdaction) == 'READ' ) THEN ! read restart related to mpp_delay !
! ===================================
DO ji = 1, nbdelay
IF ( c_delaycpnt(ji) == cdcpnt ) THEN
CALL iom_chkatt( kncid, 'DELAY_'//c_delaylist(ji), llattexist, indim )
IF( llattexist ) THEN
ALLOCATE( todelay(ji)%z1d(indim) )
CALL iom_getatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
ndelayid(ji) = 0 ! set to 0 to specify that the value was read in the restart
ENDIF
ENDIF
END DO
! ====================================
ELSE ! write restart related to mpp_delay !
! ====================================
DO ji = 1, nbdelay ! save only ocean delayed global communication variables
IF ( c_delaycpnt(ji) == cdcpnt ) THEN
IF( ASSOCIATED(todelay(ji)%z1d) ) THEN
CALL mpp_delay_rcv(ji) ! make sure %z1d is received
CALL iom_putatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
ENDIF
ENDIF
END DO
!
ENDIF
END SUBROUTINE iom_delay_rst
!!----------------------------------------------------------------------
!! INTERFACE iom_put
!!----------------------------------------------------------------------
SUBROUTINE iom_p0d_sp( cdname, pfield0d )
CHARACTER(LEN=*), INTENT(in) :: cdname
REAL(sp) , INTENT(in) :: pfield0d
!! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson
#if defined key_xios
!!clem zz(:,:)=pfield0d
!!clem CALL xios_send_field(cdname, zz)
CALL xios_send_field(cdname, (/pfield0d/))
#else
IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings
#endif
END SUBROUTINE iom_p0d_sp
SUBROUTINE iom_p0d_dp( cdname, pfield0d )
CHARACTER(LEN=*), INTENT(in) :: cdname
REAL(dp) , INTENT(in) :: pfield0d
!! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson
#if defined key_xios
!!clem zz(:,:)=pfield0d
!!clem CALL xios_send_field(cdname, zz)
CALL xios_send_field(cdname, (/pfield0d/))
#else
IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings
#endif
END SUBROUTINE iom_p0d_dp
SUBROUTINE iom_p1d_sp( cdname, pfield1d )
CHARACTER(LEN=*) , INTENT(in) :: cdname
REAL(sp), DIMENSION(:), INTENT(in) :: pfield1d
#if defined key_xios
CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
#else
IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings
#endif
END SUBROUTINE iom_p1d_sp
SUBROUTINE iom_p1d_dp( cdname, pfield1d )
CHARACTER(LEN=*) , INTENT(in) :: cdname
REAL(dp), DIMENSION(:), INTENT(in) :: pfield1d
#if defined key_xios
CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
#else
IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings
#endif
END SUBROUTINE iom_p1d_dp
SUBROUTINE iom_p2d_sp( cdname, pfield2d )
CHARACTER(LEN=*) , INTENT(in) :: cdname
REAL(sp), DIMENSION(:,:), INTENT(in) :: pfield2d
IF( iom_use(cdname) ) THEN
#if defined key_xios
IF( is_tile(pfield2d) == 1 ) THEN
ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
CALL xios_send_field( cdname, pfield2d )
ENDIF
#else
WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
#endif
ENDIF
END SUBROUTINE iom_p2d_sp
SUBROUTINE iom_p2d_dp( cdname, pfield2d )
CHARACTER(LEN=*) , INTENT(in) :: cdname
REAL(dp), DIMENSION(:,:), INTENT(in) :: pfield2d
IF( iom_use(cdname) ) THEN
#if defined key_xios
IF( is_tile(pfield2d) == 1 ) THEN
ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
CALL xios_send_field( cdname, pfield2d )
ENDIF
#else
WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
#endif
ENDIF
END SUBROUTINE iom_p2d_dp
SUBROUTINE iom_p3d_sp( cdname, pfield3d )
CHARACTER(LEN=*) , INTENT(in) :: cdname
REAL(sp), DIMENSION(:,:,:), INTENT(in) :: pfield3d
IF( iom_use(cdname) ) THEN
#if defined key_xios
IF( is_tile(pfield3d) == 1 ) THEN
ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
CALL xios_send_field( cdname, pfield3d )
ENDIF
#else
WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
#endif
ENDIF
END SUBROUTINE iom_p3d_sp