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