930
931
933
935
936
937
938 integer, intent(in) :: ng, model, tindex
939 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
940 integer, intent(in) :: Vsize(4)
941
942 integer(i8b), intent(out), optional :: checksum
943
944 real(dp), intent(in) :: Ascl
945 real(r8), intent(out) :: Amin
946 real(r8), intent(out) :: Amax
947
948 character (len=*), intent(in) :: ncname
949 character (len=*), intent(in) :: ncvname
950
951# ifdef ASSUMED_SHAPE
952# ifdef MASKING
953 real(r8), intent(in) :: Amask(LBi:,LBj:)
954# endif
955 real(r8), intent(out) :: Adat(LBi:,LBj:,LBk:)
956# else
957# ifdef MASKING
958 real(r8), intent(in) :: Amask(LBi:UBi,LBj:UBj)
959# endif
960 real(r8), intent(out) :: Adat(LBi:UBi,LBj:UBj,LBk:UBk)
961# endif
962
963 TYPE (File_desc_t), intent(inout) :: pioFile
964 TYPE (IO_Desc_t), intent(inout) :: pioDesc
965 TYPE (My_VarDesc), intent(inout) :: pioVar
966
967
968
969 logical :: Lchecksum
970 logical, dimension(3) :: foundit
971
972 integer :: i, j, k, Npts, status
973 integer :: Is, Ie, Js, Je
974 integer :: Imin, Imax, Jmin, Jmax
975 integer :: Cgrid, ghost, dkind, gtype
976
977 integer, dimension(4) :: start, total
978
979 real(r8) :: Afactor, Aoffset, Aspval, Avalue
980 real(r8) :: my_Amin, my_Amax
981
982 real(r8), dimension(3) :: AttValue
983 real(r8), dimension(2) :: rbuffer
984
985 real(r4), pointer :: Awrk4(:,:,:)
986 real(r8), pointer :: Awrk8(:,:,:)
987 real(r8), allocatable :: Cwrk(:)
988
989 character (len=12), dimension(3) :: AttName
990 character (len= 3), dimension(2) :: op_handle
991
992 character (len=*), parameter :: MyFile = &
993 & __FILE__//", pio_fread3d"
994
995
996
997
998
999 status=pio_noerr
1000 amin=spval
1001 amax=-spval
1002 my_amin=spval
1003 my_amax=-spval
1004
1005
1006
1007
1008
1009 dkind=piovar%dkind
1010 gtype=piovar%gtype
1011
1012 SELECT CASE (abs(gtype))
1013 CASE (p2dvar, p3dvar)
1014 cgrid=1
1015 is=iobounds(ng)%ILB_psi
1016 ie=iobounds(ng)%IUB_psi
1017 js=iobounds(ng)%JLB_psi
1018 je=iobounds(ng)%JUB_psi
1019 CASE (b3dvar, l3dvar, r2dvar, r3dvar, w3dvar)
1020 cgrid=2
1021 is=iobounds(ng)%ILB_rho
1022 ie=iobounds(ng)%IUB_rho
1023 js=iobounds(ng)%JLB_rho
1024 je=iobounds(ng)%JUB_rho
1025 CASE (u2dvar, u3dvar)
1026 cgrid=3
1027 is=iobounds(ng)%ILB_u
1028 ie=iobounds(ng)%IUB_u
1029 js=iobounds(ng)%JLB_u
1030 je=iobounds(ng)%JUB_u
1031 CASE (v2dvar, v3dvar)
1032 cgrid=4
1033 is=iobounds(ng)%ILB_v
1034 ie=iobounds(ng)%IUB_v
1035 js=iobounds(ng)%JLB_v
1036 je=iobounds(ng)%JUB_v
1037 CASE DEFAULT
1038 cgrid=2
1039 is=iobounds(ng)%ILB_rho
1040 ie=iobounds(ng)%IUB_rho
1041 js=iobounds(ng)%JLB_rho
1042 je=iobounds(ng)%JUB_rho
1043 END SELECT
1044
1045
1046
1047 ghost=0
1048 imin=bounds(ng)%Imin(cgrid,ghost,myrank)
1049 imax=bounds(ng)%Imax(cgrid,ghost,myrank)
1050 jmin=bounds(ng)%Jmin(cgrid,ghost,myrank)
1051 jmax=bounds(ng)%Jmax(cgrid,ghost,myrank)
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066 attname(1)='scale_factor'
1067 attname(2)='add_offset '
1068 attname(3)='_FillValue '
1069
1071 & attvalue, foundit, &
1072 & piofile = piofile)
1073 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
1074 status=ioerror
1075 RETURN
1076 END IF
1077
1078 IF (.not.foundit(1)) THEN
1079 afactor=1.0_r8
1080 ELSE
1081 afactor=attvalue(1)
1082 END IF
1083
1084 IF (.not.foundit(2)) THEN
1085 aoffset=0.0_r8
1086 ELSE
1087 aoffset=attvalue(2)
1088 END IF
1089
1090 IF (.not.foundit(3)) THEN
1091 aspval=spval_check
1092 ELSE
1093 aspval=attvalue(3)
1094 END IF
1095
1096
1097
1098 IF (PRESENT(checksum)) THEN
1099 lchecksum=.true.
1100 checksum=0_i8b
1101 ELSE
1102 lchecksum=.false.
1103 END IF
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113 IF (dkind.eq.pio_double) THEN
1114 IF (.not.associated(awrk8)) THEN
1115 allocate ( awrk8(imin:imax, jmin:jmax, lbk:ubk) )
1116 END IF
1117 awrk8=0.0_r8
1118 ELSE
1119 IF (.not.associated(awrk4)) THEN
1120 allocate ( awrk4(imin:imax, jmin:jmax, lbk:ubk) )
1121 END IF
1122 awrk4=0.0_r4
1123 END IF
1124
1125
1126
1127 IF (tindex.gt.0) THEN
1128 CALL pio_setframe (piofile, &
1129 & piovar%vd, &
1130 & int(tindex, kind=pio_offset_kind))
1131 END IF
1132
1133
1134
1135 IF (dkind.eq.pio_double) THEN
1136 CALL pio_read_darray (piofile, &
1137 & piovar%vd, &
1138 & piodesc, &
1139 & awrk8(imin:,jmin:,lbk:), &
1140 & status)
1141
1142 DO k=lbk,ubk
1143 DO j=jmin,jmax
1144 DO i=imin,imax
1145 IF (abs(awrk8(i,j,k)).ge.abs(aspval)) THEN
1146 adat(i,j,k)=0.0_r8
1147 ELSE
1148 avalue=ascl*(afactor*awrk8(i,j,k)+aoffset)
1149 adat(i,j,k)=avalue
1150 my_amin=min(my_amin,avalue)
1151 my_amax=max(my_amax,avalue)
1152 END IF
1153 END DO
1154 END DO
1155 END DO
1156 IF (associated(awrk8)) deallocate (awrk8)
1157
1158
1159
1160 ELSE
1161 CALL pio_read_darray (piofile, &
1162 & piovar%vd, &
1163 & piodesc, &
1164 & awrk4(imin:,jmin:,lbk:), &
1165 & status)
1166
1167 DO k=lbk,ubk
1168 DO j=jmin,jmax
1169 DO i=imin,imax
1170 IF (abs(awrk4(i,j,k)).ge.abs(aspval)) THEN
1171 adat(i,j,k)=0.0_r8
1172 ELSE
1173 avalue=real(ascl*(afactor*awrk4(i,j,k)+aoffset),r8)
1174 adat(i,j,k)=avalue
1175 my_amin=real(min(my_amin,avalue),r8)
1176 my_amax=real(max(my_amax,avalue),r8)
1177 END IF
1178 END DO
1179 END DO
1180 END DO
1181 IF (associated(awrk4)) deallocate (awrk4)
1182 END IF
1183
1184
1185
1186 IF (lchecksum) THEN
1187 npts=(imax-imin+1)*(jmax-jmin+1)*(ubk-lbk+1)
1188 IF (.not.allocated(cwrk)) allocate ( cwrk(npts) )
1189 cwrk=pack(adat(imin:imax, jmin:jmax, lbk:ubk), .true.)
1190 CALL get_hash (cwrk, npts, checksum, .true.)
1191 IF (allocated(cwrk)) deallocate (cwrk)
1192 END IF
1193
1194
1195
1196 rbuffer(1)=my_amin
1197 rbuffer(2)=my_amax
1198 op_handle(1)='MIN'
1199 op_handle(2)='MAX'
1200 CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
1201 amin=rbuffer(1)
1202 amax=rbuffer(2)
1203
1204 IF ((abs(amin).ge.abs(spval)).and. &
1205 & (abs(amax).ge.abs(spval))) THEN
1206 amin=0.0_r8
1207 amax=0.0_r8
1208 END IF
1209
1210 RETURN