changequote({,})changecom({!})dnl define({typename}, {ifelse(type, {DOUBLE}, {DOUBLE PRECISION}, type)})dnl ! Copyright (C) GFD Dennou Club, 2001. All rights reserved SUBROUTINE ANVARPUT{}type{}(VAR, START, COUNT, STRIDE, IMAP, SIZ, VALUE, IOSTAT) USE AN_TYPES, ONLY: AN_VARIABLE USE AN_VARTABLE, ONLY: AN_VARIABLE_ENTRY, VTABLE_LOOKUP USE NETCDF_F77, ONLY: NF_NOERR, NF_EINVAL, NF_PUT_VARM_{}type{} USE AN_FILE, ONLY: ANFILEDATAMODE USE DC_TRACE, ONLY: BEGINSUB, ENDSUB, MESSAGE IMPLICIT NONE TYPE(AN_VARIABLE), INTENT(IN):: VAR INTEGER, INTENT(IN):: START(:) INTEGER, INTENT(IN):: COUNT(:) INTEGER, INTENT(IN):: STRIDE(:) INTEGER, INTENT(IN):: IMAP(:) INTEGER, INTENT(IN):: SIZ {}typename{}, INTENT(IN):: VALUE(SIZ) INTEGER, INTENT(OUT):: IOSTAT INTEGER:: NDIMS TYPE(AN_VARIABLE_ENTRY):: ENT CHARACTER(LEN = *), PARAMETER:: SUBNAME = "ANVARPUT{}type{}" CONTINUE CALL BEGINSUB(SUBNAME) IOSTAT = VTABLE_LOOKUP(VAR, ENT) IF (IOSTAT /= NF_NOERR) GOTO 999 NDIMS = 0 IF (ASSOCIATED(ENT%DIMIDS)) NDIMS = SIZE(ENT%DIMIDS) IF (MIN(SIZE(START), SIZE(COUNT), SIZE(STRIDE), SIZE(IMAP)) < NDIMS) THEN IOSTAT = NF_EINVAL GOTO 999 ENDIF CALL MESSAGE("F=%D V=%D STA=%*D C=%*D STR=%*D IMAP=%*D", & & I=(/ENT%FILEID, ENT%VARID, START, COUNT, STRIDE, IMAP/), & & N=(/NDIMS, NDIMS, NDIMS, NDIMS/)) IOSTAT = ANFILEDATAMODE(ENT%FILEID) IF (IOSTAT /= NF_NOERR) RETURN IOSTAT = NF_PUT_VARM_{}type{}(ENT%FILEID, ENT%VARID, & & START, COUNT, STRIDE, IMAP, VALUE) 999 CONTINUE CALL ENDSUB(SUBNAME, "IOSTAT=%d", I=(/IOSTAT/)) END SUBROUTINE